;;; -*- Mode:MIDAS -*- 
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, see https://gnu.org/licenses or
;;; write to:
;;;  Free Software Foundatiom, Inc.
;;;  51 Franklin St, Fifth Floor
;;;  Boston, MA 02110-1301
;;;  USA

.SEE COPY	;COPY BLOCK TO BLOCK
.SEE DUP	;DUPLICATE ENTIRE DISC PACK
.SEE TRAN	;LOAD FROM MAG TAPE UNIT 5
.SEE UCOP	;COPY UDIRS FROM DRIVE TO DRIVE
.SEE ZAP	;ZERO DIR BLOCKS, WRITE OUT EMPTY TUT,MFD, WRITE READIN BLOCK
.SEE SPKID	;SET PACK ID IN TUT
.SEE DSKTST	;SIMPLE DISK TEST (WRITE THEN READ)
.SEE SEKTST	;DISK TEST WHICH SEEKS BACK AND FORTH (DOES NO WRITING)
.SEE MARK	;FORMAT PACK
.SEE MARK69	;FINISH FORMATTING PACK
.SEE MFDR	;TRY TO RECONSTRUCT MFD FROM USER DIRS
.SEE CHKR	;SALVAGER
.SEE GOGO	;SALVAGER - (AUTO FOR ALL DRIVES)
.SEE GETSTS	;GET CONTROLLER AND CURRENT DRIVE STATUS
.SEE RDHEAD	;READ HEADER FROM TRACK
.SEE LISTF	;PRINT USER DIRECTORY ON LPTR
.SEE UNLOCK	;TEST & UNLOCK A BLOCK
.SEE REMAP	;REMAP PACK #S AND FIX UFDS

.SEE PUNCH	;VARIABLE TO BE SET NON-ZERO IF COPYING OF TTY OUTPUT TO PAPER TAPE IS WANTED
.SEE HCRASH	;VARIABLE TO BE SET NON-ZERO IF DUP'ING A DISK AFTER HEAD CRASH
.SEE NOQUES	;IF NON-ZERO, NO QUESTIONS IN GOGOX MODE
.SEE FERRS	;COUNT OF CORRECTABLE ERRORS
.SEE CERRS	;COUNT OF ECC-CORRECTED ERRORS (RP04 ONLY)
.SEE DUPRER	;COUNT OF BLOCKS THAT COULDN'T BE READ IN `DUP'
.SEE DUPWER	;COUNT OF BLOCKS THAT COULDN'T BE WRITTEN IN `DUP'

IF1,	TITLE SALVATION
IF2,[	PRINTX/SALVATION /
	.TYO6 .FNAM2
	PRINTX/
/]

DEFINE SUBTTL A/
TERMIN

;AC'S

ZR=0
A=1
B=2
C=3
D=4
N=5
I=6
Q=7
H=10
TT=11
T=12
W=13
U=14
J=15
K=16
P=17

SUBTTL CONFIGURATION

DEFINE IFCE A,B
IFE SIXBIT/A/-SIXBIT/B/,TERMIN	;SUBSTITUTE FOR IFSE THAT IGNORES CASE

;OPTIONS

IF1,[
PRINTX /Run under time-sharing? /
.TTYMAC TS
 IRPS Z,,[YES Y AYE DA JA]
  IFCE Z,TS,{
	ITS==1
	IRPS ZZ,,[DC10P RP10P RH10P OLPTP NLPTP TTLPTP KL10P]
	 ZZ==0
	 TERMIN
	.ISTOP
	}
 TERMIN
TERMIN

IFNDEF ITS,[		;run stand alone
ITS==0
PRINTX /Which machine? /
.TTYMAC MCHN
 IFCE MCHN,AIKA,[
	FIRSPK==1	;first pack that must be mounted in gogo mode
	LASTPK==5	;last pack that must be mounted in gogo mode
	NUDSL==440.
	DC10P==1
	RP10P==0
	RH10P==0
	T300P==0
	KL10P==0
	OLPTP==0	;R.I.P.
	NLPTP==0
	TTLPTP==0
	TCMXH==55.
	LIGHTS==4	;PI
	];AIKA
 IFCE MCHN,ML,[
	FIRSPK==2
	LASTPK==3
	NUDSL==250.
	DC10P==0
	RP10P==1
	RH10P==0
	T300P==0
	KL10P==0
	OLPTP==0
	NLPTP==0	;rest in pieces
	TTLPTP==0
	TCMXH==55.
	LIGHTS==4	;PI
	];ML
 IFCE MCHN,DM,[
	FIRSPK==17.
	LASTPK==21.
	NUDSL==200.
	DC10P==0
	RP10P==1
	RH10P==0
	T300P==0
	KL10P==0
	OLPTP==0
	NLPTP==0
	TTLPTP==100
	TCMXH==55.
	LIGHTS==4	;PI
	];DM
 IFCE MCHN,MC,[
	SA==105*2000	; MC system is big, need to push SALV higher.
	FIRSPK==0
	LASTPK==1
	NUDSL==500.
	DC10P==0
	RP10P==0
	RH10P==1
	T300P==3	;UNIT 3 IS FIRST T-300 UNIT
	KL10P==1
	OLPTP==0
	NLPTP==0
	TTLPTP==0	;NO LPT AT ALL
	TCMXH==100.	;LA36
	LIGHTS==500	;KL-UDGE
	NDRIVE==6	;8 DOESN'T FIT IN 128K
	NUNITS==6
	];KL
TERMIN
IFNDEF FIRSPK, .FATAL UNKNOWN MACHINE "MCHN"
];IFNDEF ITS

;Formerly we knew number of units, now these are set to maximum and at run
; time we find out which units are present and on-line with the right packs.
IFNDEF NDRIVE, NDRIVE==8	;# physical units
IFNDEF NUNITS, NUNITS==8	;# virtual units

IFE NUNITS-NDRIVE,[	;Hack for virtual units in pre-Calcomp AI-KA system.
 DEFINE UNTMES A/
 TYPE A
 TERMIN
]
IFN NUNITS-NDRIVE,[
 DEFINE UNTMES A/
  DEFINE ZZQ UNIT
   TYPE A
  TERMIN
  ZZQ [VIRTUAL UNIT]
 TERMIN
]

;MACROS FOR CONDITIONALIZATION

DEFINE TS
IFN ITS!TERMIN

DEFINE NTS
IFE ITS!TERMIN

DEFINE DC
IFN DC10P!TERMIN

DEFINE RP
IFN RP10P!TERMIN

DEFINE RH
IFN RH10P!TERMIN

DEFINE KA
IFE KL10P!TERMIN

DEFINE KL
IFN KL10P!TERMIN

DEFINE INSIRP I,[X]
IRPS Z,,X
 I,Z
TERMIN
TERMIN

DEFINE INFORM A,B,C,D,E,F,G
PRINTX \A!B!C!D!E!F!G
\
TERMIN

DEFINE CONC A,B
A!B!TERMIN

DEFINE STRA C/
	MOVE A,[440700,,[ASCIZ \C\]]
TERMIN

DEFINE LPR B/
	JSR LOUTST
	 [ASCIZ \B\]
TERMIN

DEFINE TYPE TXT/
	JSR TOUTST
	 [ASCIZ \TXT\]
TERMIN

TS	INFORM Runs under time-sharing on any machine
DC	INFORM Systems Concepts disk control
RP	INFORM DEC RP10 disk control
RH	INFORM DEC RH10 disk control
	INFORM Number of drives=,\ndrives
;	INFORM Number of virtual units=,\nunits
KA	INFORM KA-10
KL	INFORM KL-10
IFN OLPTP, INFORM Old LPT Interface
IFN NLPTP, INFORM New LPT Interface
IFN TTLPTP, INFORM LPT on MTY line number ,\TTLPTP&77
TS, T300P==0
IFN T300P, INFORM Support for Trident T-300 via PDP-11
];IF1

MEMSIZ==1000000
IFNDEF SA,SA==100*2000

NLPT=464	;device code of ML lpt
MTY==400	;device code of scanner

APR==0
PI==4
KA, TTY==120
KA, PTP==100
IFN T300P, DLB==60	;DL-10
.ALSO	   DLC==64

X=PUSHJ P,

NTS,[	LOC SA
	JRST GOGO	;make easy to start from ITS core load
SALVRT:	0		;system may JSR here
	JRST SALVAG
];NTS

;DISK PHYSICAL PARAMETERS

DC,[
	.INSRT SYSTEM;DC10 >
]
RP,[
	.INSRT SYSTEM;RP10 >
]
RH,[
	.INSRT SYSTEM;RH10 >
]
TS,	NTUTBL==4	;MAXIMUM NUMBER OF BLOCKS PER TUT ON ANY ITS

;FILE SYSTEM PARAMETERS

.INSRT SYSTEM;FSDEFS >

IFN T300P,[

		;DL10 COMMUNICATIONS AREA IN NON-ENCACHED LOW CORE
DL10AR==500	;ACTUAL STORAGE LAYOUT DEFINED IN ITS AND IN T300 DEFS

	.INSRT SYSTEM;T300 >
MXTUTB==NTUTB1	;MAXIMUM OF NTUTBL AND NTUTB1
];T300P
.ELSE MXTUTB==NTUTBL

DC,[
DEFINE QCOPY A,B
DCOPY A(-<B>_2&37774)!TERMIN
];DC

;DEFINE CHANNEL PROGRAM AREA

NTS,[
KL,[
	.INSRT SYSTEM;EPT >

ZZ==.
	LOC EPTDDT
	JRST MEMSIZ-4000	;FOR 'DDT' COMMAND IN KLDCP
LOC ZZ

PAG==10
..D010==0
SWPIA=701440,,0
SWPUO=701740,,0
SWPIO=701640,,0
SWPUA=701540,,0
];KL
KA,[
SLVICWA=20
SLVIOWD=22
];KA
];NTS

TS,[
TYIC==1
TYOC==2
LPTC==3
QIN==4
]

IF2,[
TS,[	NBLKS==10000.	;FAKE
	TBLKS==10000.	;FAKE
	MFDBLK==-1	;JUST TO AVOID UNDEF SYM ERROR, VALUE NEVER USED
;	TUTBLK==-1	;..
];TS
];IF2

SUBTTL COPY BLOCK TO BLOCK

NTS,[

COPY:	JSR INIT
	PUSHJ P,CRR
	UNTMES COPY BLOCK FROM UNIT #
	PUSHJ P,NTYI
	 JRST COPY
	CAIL A,NUNITS
	 JRST COPY
	MOVEM A,FROM
	MOVE I,A
	PUSHJ P,RESET
CP1:	PUSHJ P,CRR
	TYPE BLOCK #
	PUSHJ P,OTYI
	CAIL A,TBLKS
	 JRST CP1
	MOVEM A,FMBLK
CP2:	PUSHJ P,CRR
	UNTMES ONTO UNIT #
	PUSHJ P,NTYI
	 JRST CP2
	CAIL A,NUNITS
	 JRST CP2
	MOVEM A,TOU
	MOVE I,A
	PUSHJ P,RESET
	PUSHJ P,CRR
CP3:	TYPE BLOCK #
	PUSHJ P,OTYI
	PUSHJ P,CRR
	CAIL A,TBLKS
	 JRST CP3
	MOVEM A,TOBLK
	MOVEI A,TUT
	MOVE J,FMBLK
	MOVE I,FROM
	PUSHJ P,READ
	JUMPL T,CPERR
COPYB:	MOVEI A,TUT		;HANDY PLACE FOR A BREAKPOINT
	MOVE J,TOBLK
	PUSHJ P,WRITT
	JRST DDT

DTYI:	MOVEI B,0		;DECIMAL TYPEIN
DTYI1:	X NTYI
	 JRST DTYI2
	IMULI B,10.
	ADD B,A
	JRST DTYI1

DTYI2:	MOVE A,B
	POPJ P,

OTYI:	MOVEI B,0		;OCTAL TYPEIN
OTYI1:	X NTYI
	 JRST DTYI2
	LSH B,3
	ADD B,A
	JRST OTYI1

CPERR:	TYPE READ ERROR
	X CRR
	JRST DDT

	SUBTTL TEST AND UNLOCK SOME BLOCKS

UNLOCK:	JSR INIT
	X CRR
	UNTMES UNLOCK BLOCKS ON UNIT #
	X NTYI
	 JRST UNLOCK
	CAIL A,NUNITS
	 JRST UNLOCK
	MOVEM A,FROM
	MOVE I,A
	X RESET
UNLK1:	X CRR
	TYPE BLOCK #
	X OTYI
	PUSHJ P,UNLOCB
	 JFCL
	JRST UNLK1		;USE ^Z TO GET OUT

;UNLOCK A BLOCK, NUMBER IN A, UNIT IN FROM

UNLOCB:	INSIRP PUSH P,[J K Q D B TT]
	MOVE J,A
	MOVEM J,FMBLK
	SETZM CYLBUF			;ZERO OUT IN CASE CAN'T READ
	MOVE A,[CYLBUF,,CYLBUF+1]
	BLT A,CYLBUF+4000-1
	MOVE I,FROM
	MOVEI A,CYLBUF
	PUSHJ P,READ
	JUMPGE T,UNLK2
	TYPE READ ERROR
	X CRR
	X GSTS
	TYPE PROCEED?
	X Y.OR.N
	 JRST UNLOCX
UNLK2:	MOVE A,[RXWDS,,WXWDS]
	BLT A,WXWDS+4-1
	MOVEI A,CYLBUF
	X WRITE
	JUMPL T,WRERR
	MOVEI A,CYLBUF+2000
	X READ
	JUMPL T,[TYPE READ-BACK ERROR
		 X CRR
		 X GSTS
		 JRST UNLOCX]
	MOVSI T,-2000
UNLK3:	MOVE TT,CYLBUF(T)
	CAME TT,CYLBUF+2000(T)
	 JRST [	TYPE READ-BACK COMPARE ERROR
		X CRR
		JRST UNLOCX]
	AOBJN T,UNLK3

	MOVEI A,TUT
	X RDTUT
	JUMPL T,CPERR
	MOVE J,FMBLK
	MOVEI B,TUT
	X TUTPNT
	JUMPE J,[ TYPE CAN'T ACCESS TUT
		  X CRR
		  JRST UNLOCX ]
	MOVEI B,1		;SAFEST ... NEXT SALVAGE WILL PUT CORRECT VALUE
	DPB B,J
	MOVEI A,TUT
	X WRTUT
	JUMPL T,WRERR
	AOS -6(P)		;WINNING, SKIP RETURN
UNLOCX:	INSIRP POP P,[TT B D Q K J]
	POPJ P,

WRERR:	TYPE WRITE ERROR
	JRST CRDDT

SUBTTL DUP - COPY ENTIRE PACK

DUP1A:	PUSHJ P,CRR
DUP1:	UNTMES  FROM UNIT #
	PUSHJ P,NTYI
	 JRST DUP1A
	CAIL A,NUNITS
	 JRST DUP1A
	MOVE I,A
	PUSHJ P,RESET
DUP2:	MOVEM A,FROM
TO:	PUSHJ P,CRR
	UNTMES ONTO UNIT #
	PUSHJ P,NTYI
	 JRST TO
	CAIL A,NUNITS
	 JRST TO
	MOVEM A,TOU
	X CRR
	UNTMES COPY FROM UNIT #
	MOVE A,FROM
	X DPT
	UNTMES  ONTO UNIT #
	MOVE A,TOU
	X DPT
	TYPE , OK?
	X Y.OR.N
	 JRST DDT
	MOVE I,TOU
	PUSHJ P,RESET
	POPJ P,

DUP:	JSR INIT
	SETZM USRDS'
	SETZM USWRTS'
	SETZM DUPRER
	SETZM DUPWER
RH,	SETZM CERRS
	TYPE DUPLICATE DISK
	PUSHJ P,DUP1
	MOVE I,FROM
DC,	MOVE A,QTRAN(I)
DC,	DPB A,[DUNFLD CYLRIR]
RP,	MOVE I,TOU
.ELSE [	MOVE A,PKNUM(I)
	MOVE I,TOU
	CAME A,PKNUM(I)
	 JRST DUPLUZ
]DC,	MOVE A,QTRAN(I)
DC,	DPB A,[DUNFLD CYLRIW]
	MOVEI J,NCYLS+XCYLS-1	;DETERMINE HOW MANY CYLINDERS THIS DRIVE
RP,[	MOVSI A,(DNOOPC)
	DPB I,[DUNFLD A]	;SELECT DESTINATION DRIVE
	DATAO DPC,A	
	DATAI DPC,B
	MOVE I,FROM
	DPB I,[DUNFLD A]	;SELECT SOURCE DRIVE
	DATAO DPC,A
	DATAI DPC,A
	XOR A,B
	TRNE A,2000
	 JRST [	TYPE CAN'T COPY RP02 TO RP03 OR VICE VERSA
		JRST CRDDT ]
	TRNE B,2000
	 MOVEI J,MCYLS+XCYLS-1	;DRIVES ARE RP03S, MORE CYLINDERS TO COPY
];RP
IFN T300P,[
	CAIL I,T300P
	 JRST T3DUP		;HAVE TO DO IT THE SLOW WAY
	MOVE I,FROM
	CAIL I,T300P
	 JRST [	TYPE CAN ONLY GO T-300 TO T-300
		JRST CRDDT ]
];T300P
	MOVEI A,CYLBUF
DLUP:	MOVE I,FROM
	PUSHJ P,READCY
	JUMPL T,DLUP1		;LOST, TRY BLOCK AT A TIME
	MOVE I,TOU
	PUSHJ P,WRITCY
	JUMPL T,DLUP1
DLUP2:	SOJGE J,DLUP
DC,	MOVEI T,CYLRIR		;COPY READ-IN BLOCK
DC,	PUSHJ P,RW0
RH,[	SKIPN A,CERRS
	 JRST DDT
	X TDPT
	TYPE  ECC-CORRECTED ERRORS.
	JRST CRDDT
]
.ELSE	JRST DDT

DUPLUZ:	TYPE PACK # DFRS
	PUSHJ P,CRR
	JRST DDT

IFN T300P,[
T3DUP:	MOVE I,FROM
	CAIGE I,T300P
	 JRST [	TYPE CAN ONLY GO T-300 TO T-300
		JRST CRDDT ]
	TYPE THIS WILL TAKE A WHILE...
	X CRR
	MOVEI J,NBLKS1+XBLKS1-1
T3DUP1:	MOVEI A,CYLBUF
	MOVE I,FROM
	X READ
	JUMPL T,CPERR
	MOVE I,TOU
	X WRITE
	JUMPL T,WRERR
	SOJGE J,T3DUP1
	JRST CRDDT
];T300P

IFE RH10P,[			;BLOCK AT A TIME
DLUP1:	PUSH P,J
	IMULI J,NBLKSC
	CLEARM DLUPT
DLUP3:	MOVE I,FROM
	MOVEI A,CYLBUF
	PUSHJ P,READ
	JUMPL T,DLUPE1
	MOVE I,[RXWDS,,WXWDS]
DLUPEW:	BLT I,WXWDS+4-1
	PUSHJ P,WRITT
	JUMPL T,DLUPE2
DLUPEX:	AOS TT,DLUPT
	CAIGE TT,NBLKSC
	 AOJA J,DLUP3
	POP P,J
	JRST DLUP2
]
RH,[				;SECTOR AT A TIME ON RP04 SO GET EXTRA SECTORS
DLUP1:	MOVEI T,NHEDS*NSECS
	MOVEM T,DLUPT
DLUP3:	SOS W,DLUPT		;NEXT SECTOR (GOING BACKWARDS THROUGH CYLINDER)
	IDIVI W,NSECS		;TRACK IN W, SECTOR IN U
	LSH W,8
	IOR W,U
	HRL W,J			;NOW W HAS DISK ADDRESS
	MOVEM W,RHPGA
	MOVE U,[-200,,CYLBUF-1]
	MOVEM U,RHIOW
	MOVE I,FROM
	MOVEI TT,%HMRED
	MOVEM TT,RHCMD
	PUSHJ P,RW1
	JUMPL T,DLUPE1
DLUPEW:	MOVE I,TOU
	MOVEI TT,%HMWRT
	MOVEM TT,RHCMD
	PUSHJ P,RW1
	JUMPL T,DLUPE2
DLUPEX:	SKIPE DLUPT
	 JRST DLUP3
	JRST DLUP2
];RH

DLUPT:	0

DLUPE1:	AOS DUPRER
	SKIPE HCRASH
	 JRST DLUPE4		;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
	TYPE Read error on block #
	PUSHJ P,DLUPE3
DLUPE4:	SETZM CYLBUF		;COULDN'T READ THE BLOCK, SUBSTITUTE ALL ZEROS
	MOVE A,[CYLBUF,,CYLBUF+1]
	BLT A,CYLBUF+2000-1
	MOVE I,[DLUPE5,,WXWDS]	;WITH SPECIAL EXTRA WORDS
	JRST DLUPEW		;RESUME DLUP AT WRITE

DLUPE3:	MOVE A,I
	X DPT
	MOVEI A,"-
	X TYO
IFE RH10P, MOVE A,J
IFN RH10P,[
	HLRZ A,RHPGA		;CYLINDER
	IMULI A,NBLKSC
	LDB W,[101000,,RHPGA]	;HEAD
	IMULI W,NSECS
	LDB U,[001000,,RHPGA]	;SECTOR
	ADD W,U
	IDIVI W,SECBLK
	ADD A,W			;INACCURATE IF UNUSED SECTOR AT END OF CYLINDER
];RH10P
	PUSHJ P,DPT
	PUSHJ P,CRR
	JRST GSTS		;HARDWARE STATUS

DLUPE2:	AOS DUPWER
	SKIPE HCRASH
	 JRST DLUPEX		;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
	TYPE Write error on block #
	PUSHJ P,DLUPE3
	JRST DLUPEX

;SUITABLE EXTRA WORDS FOR BLOCKS THAT COULDN'T BE READ

DLUPE5:	0			;WORD COUNT=2000, LAST BLOCK=0
	SIXBIT /??????/		;DUMMY DIRECTORY
	SIXBIT /(DISK)/
	SIXBIT/LOSSAG/

DC,[	SUBTTL CYLINDER I/O, DC10
READCY:	SKIPA T,[DREADC+DUNENB]		;READ CONTINUOUS
WRITCY:	MOVSI T,(DWRITC+DUNENB)		;WRITE CONTINUOUS
	MOVE TT,QTRAN(I)
	DPB TT,[DUNFLD T]
	MOVE TT,J
	SKIPGE QTRAN(I)
	 ADDI TT,NCYLS+XCYLS
	DPB TT,[DCYL T]
	DPB TT,[DCYL CYLCM3]
CYL1:	SKIPLE TT,PKNUM(I)
	 JRST CYL2
	PUSH P,T
	PUSHJ P,RESET
	POP P,T
	JRST CYL1

CYL2:	CAIL J,NCYLS
	 MOVEI TT,0
	DPB TT,[DPKID T]
	DPB TT,[DPKID CYLCM3]
	MOVEM T,CYLCOM
	DPB A,[DCCA CYLCM1]
	DPB A,[DCCA CYLCM2]
	MOVEI T,CYLCOM
RW0:	HRRM T,DGO
	JRST RW1		;TRY TRANSFER UNTIL SUCCEEDS

CYLCOM:	0
	DALU+DLDBWC+DLLB -2004*NBLKSC(3)	;LOAD WORD COUNT WITH -2004*NO. OF BLOCKS/CYL
CYLCM1:	DCOPY .
CYLCM3:	DRCC			;READ COMPARE CONTINUOUS
	DALU+DLDBWC+DLLB -2004*NBLKSC(3)
CYLCM2:	DCCOMP .
	DHLT

CYLRIR:	DREAD+DUNENB
	DCOPY CYLBUF(-LRIBLK_2&37774)
CYLRIW:	DWRITE+DUNENB
	DCOPY CYLBUF(-LRIBLK_2&37774)
	DHLT
];DC

RP,[	SUBTTL CYLINDER I/O, RP10 & RH10 CONTROLS

;RP10 CYLINDER I/O ALWAYS SUCCEEDS.  IF PROBLEMS OCCUR, GOES SECTOR
;AT A TIME, TYPING OUT WHAT IS GOING ON, ZEROING SECTORS THAT CAN'T BE READ,
;THEN RETURNS CLAIMING TO HAVE WON.
READCY:	SKIPA T,DRD
WRITCY:	 MOVE T,DWR
	MOVEM T,RPIOOP
	MOVEM J,RPIOCY
	SETZM RPIOHD
	SETZM RPIOSC
	MOVEM A,RPAOBJ
	MOVNI T,NBLKSC*2000
	HRLM T,RPAOBJ
RPCY0:	PUSHJ P,RPIO
	JUMPGE T,CPOPJ		;WON
IFN 0,[				;I DON'T THINK THIS CODE WORKS
	SKIPE HCRASH
	 POPJ P,
	MOVE T,RPIOOP
	CAMN T,DWR
	 JRST [	TYPE WRITE ERROR ON BLOCK 
		JRST .+3 ]
	  TYPE READ ERROR ON BLOCK 
	PUSH P,A
	PUSH P,B
	MOVE A,I
	X DPT
	TYPE -
	MOVE A,RPIOHD
	IMULI A,NSECS
	ADD A,RPIOSC
	IDIVI A,SECBLK
	MOVE B,RPIOCY
	IMULI B,NBLKSC
	ADD A,B
	X DPT
	X CRR
	POP P,B
	POP P,A
	PUSHJ P,GSTS		;EXPLAIN WHAT HAPPENED TO THIS SECTOR
	MOVE T,RPIOOP		;IF READ, ZERO THE BUFFER
	HRLZ TT,RPAOBJ		;IF WAS REALLY IN SECTOR AT A TIME MODE
	CAMN T,DRD
	 CAIE TT,-200
	  JRST RPCY1
	MOVE TT,RPAOBJ
	SETZM (TT)
	HRLZ T,TT
	HRRI T,1(TT)
	BLT T,177(TT)
RPCY1:	AOS T,RPIOSC		;ADVANCE TO NEXT SECTOR
	CAIGE T,NSECS
	 JRST RPCY2
	SETZM RPIOSC
	AOS T,RPIOHD
	CAIL T,NHEDS
	 POPJ P,		;MUST BE DONE
RPCY2:	MOVE T,[200,,200]
	ADDB T,RPAOBJ
	JUMPL T,RPCY0		;GO DO THE REST OF THE CYLINDER
];IFN 0
	POPJ P,			;HMM, MUST BE DONE
];RP

RH,[	;CYLINDER I/O, RH10 CONTROL

READCY:	SKIPA TT,[%HMRED]
WRITCY:	 MOVEI TT,%HMWRT
IFN T300P,[
	CAIL I,T300P
	 JRST 4,.		;NOT CODED YET
	SETZM T3IOP
];T300P
	MOVEM TT,RHCMD
	HRLZM J,RHPGA		;SET ADDRESS TO START OF CYLINDER
	MOVEI T,-1(A)		;SET UP IOWD TO TRANSFER WHOLE CYLINDER
	HRLI T,-200*NHEDS*NSECS	;- NUMBER OF WORDS TO TRANSFER
	MOVEM T,RHIOW
	JRST RW1
];RH

SUBTTL TRAN - LOAD FROM MAG TAPE

MAGOP:	AOSE ITAPE
	 JRST MTR1
	HRROI A,MAGHD
	PUSHJ P,MREAD
	MOVE A,MAGHD
	TRNE A,-1
	 JRST MBDTHD
	CAMGE A,[-LTHBLK,,]
	 JRST MBDTHD
	ADD A,[1,,THBLK+1]
	PUSHJ P,MREAD
	TYPE TAPE # 
	HLRZ A,THTPN
	PUSHJ P,TDPT
	PUSHJ P,CRR

MTR1:	HRROI A,MAGHD
	PUSHJ P,MREAD
	JUMPE T,CPOPJ		;EOF
	MOVE A,MAGHD
	TRNE A,-1
	 JRST MBADHD
	CAMGE A,[-LMHBLK,,0]
	 JRST MBADHD
	ADD A,[1,,MHBLK+1]
	PUSHJ P,MREAD
	SETZM LNKFLG
	HLRZ B,MHPKN
	JUMPE B,POPJ1		;NOT A LINK
	SETOM LNKFLG
	MOVE A,[-3,,LNKNM1]	;READ LINK INFO
	PUSHJ P,MREAD
	JRST POPJ1

MBADHD:	LPR BAD HEADER
	PUSHJ P,LCRR
	PUSHJ P,IGFIL
	JRST MTR1

MBDTHD:	TYPE BAD TAPE HEADER
	JRST CRDDT

TRAN:	PUSHJ P,REW
TRAN1:	JSR INIT
	PUSHJ P,CRR
	MOVEI I,0
TRAN2:	SKIPGE QACT(I)
	 PUSHJ P,RESET
	CAIGE I,NUNITS-1
	 AOJA I,TRAN2
	MOVEI A,5		;READS FROM TAPE UNIT 5
	PUSHJ P,DUP2
	MOVEI A,TUT
	MOVE I,TOU
	PUSHJ P,RDTUT
	JUMPL T,READC
	MOVEI A,MFD
	MOVE J,MFDBK
	PUSHJ P,READT

TNAML:	PUSHJ P,MAGOP
	 JRST MREOT
	MOVE A,MHFN1		;DON'T RELOAD DIRECTORIES!
	MOVE B,MHFN2
	CAMN A,[SIXBIT/.FILE./]
	 CAME B,[SIXBIT/(DIR)/]
	  CAIA
	   JRST TIGNF
	CAMN A,[SIXBIT/M.F.D./]
	 CAME B,[SIXBIT/(FILE)/]
	  SKIPA A,MHSNM
	   JRST TIGNF
	PUSHJ P,SIXLPT
	PUSHJ P,LSPAC
	MOVE A,MHFN1
	PUSHJ P,SIXLPT
	PUSHJ P,LSPAC
	MOVE A,MHFN2
	PUSHJ P,SIXLPT
	PUSHJ P,LSPAC
	CLEARM FERRS
	MOVE B,MHSNM
	MOVE A,MFD+MDNAMP
	SETZM IBLK
TMLKP:	CAIL A,2000
	 JRST TNEWU
	SKIPN C,MFD+MNUNAM(A)
	 JRST TMLKZ
	CAMN B,C
	 JRST TOLDU
TMLKL:	ADDI A,LMNBLK
	JRST TMLKP

TMLKZ:	MOVEM A,IBLK
	JRST TMLKL

TOLDU:	HRREI J,-2000(A)	;CONVERT MFD INDEX TO BLOCK NO
	ASH J,-1
	ADD J,NUDS
	MOVEM J,UFDTA
	MOVEI A,NUSRD
	PUSHJ P,READT
	CAME B,NUSRD+UDNAME
	 JRST 4,.
	JRST TOLDUR

TNEWU:	MOVE A,[NUSRD,,NUSRD+1]
	SETZM NUSRD
	BLT A,NUSRD+1777
	MOVEM B,NUSRD+UDNAME
	MOVEI A,2000
	MOVEM A,NUSRD+UDNAMP
	SKIPE A,IBLK
	 JRST .+3
	  MOVNI A,LMNBLK
	  ADDB A,MFD+MDNAMP
	MOVEM B,MFD+MNUNAM(A)
	HRREI J,-2000(A)	;CONVERT MFD INDEX TO BLOCK NO
	ASH J,-1
	ADD J,NUDS
	MOVEM J,UFDTA
TOLDUR:
	MOVE B,MHFN1
	MOVE C,MHFN2
	MOVE A,NUSRD+UDNAMP
	SETZM IBLK
TULKP:	CAIL A,2000
	 JRST TNEWF
	MOVSI T,UNCDEL
	TDNE T,NUSRD+UNRNDM(A)
	 JRST TULKD
	SKIPN T,NUSRD+UNFN1(A)
	 JRST TULKZ
	CAME B,T
	 JRST TULKL
	CAMN C,NUSRD+UNFN2(A)
	 JRST TOLDF
TULKL:	ADDI A,LUNBLK
	JRST TULKP

TULKZ:	SKIPN NUSRD+UNFN2(A)
TULKD:	 MOVEM A,IBLK
	JRST TULKL

TOLDF:	LPR EXISTS
	PUSHJ P,LCRR
TIGNF:	PUSHJ P,IGFIL
	JRST TNAML

IGFIL:	MOVE A,[-2000,,FDBUF]
	PUSHJ P,MREAD
	SKIPN EOUF
	 JRST IGFIL
	CLEARM EOUF
	POPJ P,

TNEWF:	SKIPE A,IBLK
	 JRST TNEWCK
	MOVNI A,LUNBLK
	ADDB A,NUSRD+UDNAMP
TNEWCR:	MOVE T,NUSRD+UDESCP
	IDIVI T,6
	CAIL T,-UDDESC(A)
	 JRST 4,.
	MOVEM B,NUSRD+UNFN1(A)
	MOVEM C,NUSRD+UNFN2(A)
DC,	MOVEM B,WXWDS+XWFN1
DC,	MOVEM C,WXWDS+XWFN2
	MOVE B,NUSRD+UDNAME
DC,	MOVEM B,WXWDS+XWSYSN
DC,	SETZM WXWDS+XWBWC
	MOVE B,NUSRD+UDESCP
	DPB B,[UNDSCP NUSRD+UNRNDM(A)]
	MOVE B,MHDATE
	MOVEM B,NUSRD+UNDATE(A)
	SETOM NUSRD+UNREF(A)
	MOVE B,TUT+QPKNUM
	DPB B,[UNPKN NUSRD+UNRNDM(A)]
	MOVEI A,NUSRD+UNRNDM(A)
	HRLI A,(UNWRDC)
	MOVEM A,TRNDEP'		;DPB WC OF LAST BLOCK LATER
	SETZM CBYT'
	SETZM OBLKS'
	SETZM IBLK'
	SETZM LBLK'
	SKIPE LNKFLG
	 JRST TRNLNK		;JUMP IF APPENDING LINK
TBLKL:
TBLKL1:	MOVE A,[-2000,,FDBUF]
	PUSHJ P,MREAD
	JUMPE T,TBLKL2
DC,	DPB T,[XWAWC WXWDS+XWBWC]
	DPB T,TRNDEP		;STORE WORD COUNT IN DIRECTORY
	MOVE T,LBLK
DC,	DPB T,[XWBLK WXWDS+XWBWC]
	AOS IBLK
	PUSHJ P,WRBLK
TBLKL2:	SKIPN EOUF
	 JRST TBLKL
	SETZM EOUF
	JRST TBDON

TNEWCK:	SKIPN NUSRD+UNFN1(A)
	SKIPE NUSRD+UNFN2(A)
	 JRST 4,.
	JRST TNEWCR

TBDON:	PUSHJ P,EBYT
	MOVEI J,UDWPH
	SKIPN LBLK
	 PUSHJ P,BYDEP
TBDON1:	MOVEI J,0
	PUSHJ P,BYDEP
	JRST TMDON

TRNLNK:	MOVE A,LNKSNM
	PUSHJ P,TRNLK1
	MOVE A,LNKNM1
	PUSHJ P,TRNLK1
	MOVE A,LNKNM2
	PUSHJ P,TRNLK1
	JRST TBDON1

TRNLK1:	MOVE K,A
	MOVEI A,6
TRNLK2:	MOVEI J,0
	LSHC J,6
	JUMPE J,TRNLK4
	CAIE J,':	
	CAIN J,';
	 JRST [	PUSH P,J
		MOVEI J,':
		PUSHJ P,BYDEP
		POP P,J
		JRST .+1 ]
	PUSHJ P,BYDEP
	SOJG A,TRNLK2
	POPJ P,

TRNLK4:	MOVEI J,';
	JRST BYDEP

READFN:	SKIPA I,FROM
READT:	 MOVE I,TOU
	PUSHJ P,READ
READC:	JUMPL T,[JRST 4,.]
	POPJ P,

WRBLK:	MOVE J,TUT+QTUTP
	AOS TUT+QTUTP
	CAML J,TUT+QLASTB
	 JRST WRLUZ
	MOVEM J,LBLK
	SETZM TUTLUZ
	MOVEI B,TUT
	PUSHJ P,TUTPNT
	LDB B,J
	JUMPN B,WRBLK
	MOVEI B,1
	DPB B,J
	MOVE J,LBLK
	MOVEI A,FDBUF
	PUSHJ P,WRITT
	SUB J,OBLKS
	ADDM J,OBLKS
	CAIN J,1
	 JRST WRBC
	PUSHJ P,EBYT
	CAIG J,UDWPH-UDTKMX
	 JRST WRBS
	MOVE J,OBLKS
	LSHC J,-NXLBYT*6
	MOVEI U,NXLBYT+1
	ADDI J,UDWPH+1
WRBL:	PUSHJ P,BYDEP
	LSHC J,6
	SOJG U,WRBL
	POPJ P,

WRLUZ:	SETCMB J,TUTLUZ'
	JUMPE J,WRLUZ1
	MOVE J,TUT+QSWAPA
	CAMGE J,TUT+QFRSTB
	 MOVE J,TUT+QFRSTB
	MOVEM J,TUT+QTUTP
	JRST WRBLK

WRLUZ1:	TYPE DISK FULL
	SKIPN NOLPT
	 X LCRR
	JRST CRDDT

WRBS:	ADDI J,UDTKMX-1
BYDEP:	MOVE T,NUSRD+UDESCP
	AOS NUSRD+UDESCP
	IDIVI T,6
	ADDI T,UDDESC
	CAML T,NUSRD+UDNAMP
	 JRST 4,.
	ADDI T,NUSRD
	HLL T,QBTBL(W)
	DPB J,T
	POPJ P,

WRBC:	AOS J,CBYT
	CAIGE J,UDTKMX
	 POPJ P,
EBYT:	PUSH P,J
	SKIPN J,CBYT
	 JRST POPJJ
	PUSHJ P,BYDEP
	SETZM CBYT
POPJJ:	POP P,J
	POPJ P,


TMDON:	MOVE J,[WXWDS,,WXWDS+1]
	SETZM WXWDS
	BLT J,WXWDS+3
	MOVE A,TUT+QTUTP
	IDIVI A,NBLKSC
	IMULI A,NBLKSC
	MOVEM A,TUT+QTUTP
	MOVEI A,TUT
	MOVE I,TOU
	PUSHJ P,WRTUT
	MOVEI I,0
TMDON2:	SKIPL QACT(I)
	 JRST TMDON1
	MOVE J,MFDBK
	MOVEI A,MFD
	PUSHJ P,WRITE
	MOVE J,UFDTA
	MOVEI A,NUSRD
	PUSHJ P,WRITE
TMDON1:	CAIGE I,NUNITS-1
	 AOJA I,TMDON2
	SKIPN FERRS
	 LPR OK
	PUSHJ P,LCRR
	JRST TNAML

SUBTTL UCOP - COPY DIRECTORIES FROM DRIVE TO DRIVE

UCOP:	JSR INIT
	TYPE COPY DIRS
	PUSHJ P,DUP1
	MOVEI A,D0
	MOVE J,MFDBK
	PUSHJ P,READFN
	PUSHJ P,WRITT
	MOVEI Q,2000
UCOPL:	SUBI Q,LMNBLK
	CAMGE Q,D0+MDNAMP
	 JRST DDT
	SKIPN B,D0(Q)
	 JRST UCOPL
	HRREI J,-2000(Q)		;CONVERT MFD INDEX TO BLOCK NO
	ASH J,-1
	ADD J,NUDS
	MOVEI A,OUSRD
	PUSHJ P,READFN
	CAME B,OUSRD+UDNAME
	 JRST 4,.
	PUSHJ P,WRITT
	JUMPL T,WRERR
	JRST UCOPL

SUBTTL SPKID - SET PACK ID IN TUT

SPKID:	JSR INIT
	CAIA
SPKID0:	 X CRR
	UNTMES SET PACK ID ON UNIT #
	X NTYI
	 JRST SPKID0
	CAIL A,NUNITS
	 JRST SPKID0
	X CRR
	MOVE I,A
	PUSHJ P,RESET
	MOVEI A,TUT
	PUSHJ P,RDTUT
	JUMPL T,ZAPLUZ
	TYPE PACK NO=
	MOVE A,TUT+QPKNUM
	X TDPT
	TYPE , CHANGE ID FROM 
	MOVE A,TUT+QPAKID
	X T6B
	TYPE  TO 
	X SIXIN
	X CRR
	JUMPE B,ZAPLUZ
	MOVEM B,TUT+QPAKID
	MOVEI A,TUT
	PUSHJ P,WRTUT
	JUMPL T,ZAPLUZ
	JRST DDT
SUBTTL REMAP - REASSIGN PACK#S AND FIX UFDS

REMAPP:	REPEAT 40, -1		;INDEX BY PACK #.  LH=NEW PACK #, RH=DISK ADDR OFFSET

REMAP:	JSR INIT
	UNTMES REMAP THE COPY OF THE UFDS ON UNIT #
	PUSHJ P,NTYI
	 JRST REMAP
	X CRR
	CAIL A,NUNITS
	 JRST REMAP
	MOVE I,A
	MOVEI A,MFD		;GET MFD
	MOVE J,MFDBK
	PUSHJ P,READ
	JUMPL T,ACTUE3
	MOVE Q,MFD+MDNAMP
REMAP1:	CAIL Q,2000		;NEXT UFD
	 JRST CRDDT
	SKIPN B,MFD+MNUNAM(Q)
	 JRST REMAP9
	MOVEM B,USRNAM
	MOVE J,Q
	SUBI J,2000
	IDIVI J,LMNBLK
	ADD J,NUDS		;UFD BLOCK NUMBER
	MOVEI A,OUSRD
	PUSHJ P,READ
	JUMPL T,CPERR
	CAME B,OUSRD+UDNAME
	 JRST CPERR
	MOVE K,OUSRD+UDNAMP
REMAP2:	CAIL K,2000		;NEXT FILE
	 JRST REMAP6
	MOVSI C,UNLINK
	TDNE C,UNRNDM+OUSRD(K)
	 JRST REMAP5		;DON'T MANGLE LINKS
	LDB C,[UNDSCP UNRNDM+OUSRD(K)]
	IDIVI C,UFDBPW
	HLL C,QBTBLI(D)
	ADDI C,UDDESC+OUSRD	;C HAS DESC POINTER
	LDB D,[UNPKN UNRNDM+OUSRD(K)] ;D HAS PK #
	SKIPGE A,REMAPP(D)	;GET MAPPING
	 JRST 4,.		;LOSER FORGOT TO PATCH IT IN
	HLRZ D,A		;GET NEW PACK #
	DPB D,[UNPKN UNRNDM+OUSRD(K)] ;CHANGE IT
	HRRE D,A		;D HAS BLOCK # OFFSET
REMAP3:	MOVE H,C
	ILDB A,C		;GET DESC
	JUMPE A,REMAP5		;EOF
	CAIG A,UDWPH
	 JRST REMAP3		;DOESN'T DEPEND ON ABS DISK ADDRESSES
	ANDI A,37		;MASK OUT LOAD-ADDR-BIT
REPEAT NXLBYT,[
	LSH A,UFDBYT
	ILDB B,C
	ADD A,B
]
	ADD A,D			;RELOCATE THE ADDRESS
	REPEAT 6,JFCL		;PATCH AREA
	MOVE C,H		;GET BACK B.P. TO START OF LOAD-ADDR DESCRIPTOR
	MOVE H,[<UFDBYT*NXLBYT+UFDBYT>_36+UFDBYT_30+A] 
REPEAT NXLBYT+1,[
	ILDB B,H
IFE .RPCNT,	ADDI B,40
	IDPB B,C
]
	JRST REMAP3

REMAP5:	ADDI K,LUNBLK
	JRST REMAP2

REMAP6:	MOVEI A,OUSRD
	PUSHJ P,WRITE
	JUMPL T,WRERR
REMAP9:	ADDI Q,LMNBLK
	JRST REMAP1

SUBTTL ZAP - ZERO DIR BLOCKS, WRITE EMPTY TUT & MFD

ZAP:	JSR INIT
	X CRR
	UNTMES INIT DIRS ON UNIT #
	PUSHJ P,NTYI
	 JRST ZAP
	CAIL A,NUNITS
	 JRST ZAP
	PUSHJ P,CRR
	MOVEM A,TOU
	MOVE I,A
RP,[	TYPE PACK NO =
	X DTYI			;IF RP, NO PK # IN HARDWARE, GET IT FROM HUMAN
	X CRR
	MOVEM A,PKNUM(I)
]	PUSHJ P,RESET		;IF DC OR RH, WILL USE PACK # FROM HARDWARE
	MOVE A,[WXWDS-1,,WXWDS]
	BLT A,WXWDS+3
	SETZM MFD		;INIT ALL BLOCKS TO ZERO
	MOVE A,[MFD,,MFD+1]
	BLT A,MFD+1777
	MOVN J,NUDS		;GET AOBJN PTR TO UFD BLOCKS
	HRLZ J,J
KL,	ADD J,[2,,2]		;PROTECT KLDCP?
	MOVEI A,MFD
ZAPL:	PUSHJ P,WRITE
	JUMPL T,ZAPLUZ
	AOBJN J,ZAPL

DC,[	CONO DC0,DCCSET+DCDENB
	DATAO DC0,[DJMP DZAP]
	CONSZ DC0,DSSACT
	 JUMPA .-1
	CONSO DC0,DSSERR
];DC
	 JRST MARK69

ZAPLUZ:	TYPE LOSE
	JRST CRDDT

DC,[
DZAP:	DWRITE			;ZERO READ-IN BLOCK
	DCSKIP (-LRIBLK_2&37774)
	DHLT
];DC

	SUBTTL SIMPLE DISK TESTS

;THIS ONE JUST WRITES A SINGLE BLOCK, READS IT BACK, AND CHECKS THAT IT'S THE SAME.
DSKTST:	JSR INIT
	SETOM HCRASH		;DON'T DO ERROR RETRY
	TYPE TEST UNIT #
	X NTYI
	 JRST DSKTST
	X CRR
	CAIL A,NUNITS
	 JRST DSKTST
	MOVE I,A
	TYPE GOT A SCRATCH PACK ON UNIT #
	X TOPT
	TYPE ?
	X Y.OR.N
	 JRST CRDDT
DSKTS0:	X RESET
	MOVEI J,NBLKSC*15.	;RANDOMLY USE CYLINDER 15.
	MOVSI A,-2000
	MOVEI B,1		;FIRST PART OF PATTERN IS FLOATING 1S
DSKT0A:	MOVEM B,D0(A)
	LSH B,1
	SKIPE B
	 AOBJN A,DSKT0A
	HRROI B,-2		;NEXT IS FLOATING 0S
DSKT0B:	MOVEM B,D0(A)
	JUMPGE B,DSKT0C
	LSH B,1
	AOS B
	AOBJN A,DSKT0B
DSKT0C:	MOVEM A,D0(A)	;REST IS AN ADDRESS PATTERN
	AOBJN A,DSKT0C
	MOVEI A,D0
	X WRITE
	JUMPL T,WRERR
DSKTS1:	MOVEI A,D1
	X READ
	PUSHJ P,TYIPSE
	MOVSI B,-2000
DSKT1A:	MOVE A,D1(B)
	CAMN A,D0(B)
DSKTS2:	 AOBJN B,DSKT1A
	JUMP DSKTS4		;CHANGE TO JUMPA FOR NO TYPEOUT
	JUMPGE B,DSKTS3		;JUMP IF COMPARED ALL
	HRRZ A,B
	X TOPT
	TYPE / 
	MOVE A,D0(B)
	X THWO
	X TSPAC
	MOVE A,D1(B)
	X THWO
	X TSPAC
	MOVE A,D0(B)
	XOR A,D1(B)
	X THWO
	X CRR
	JRST DSKTS2

DSKTS3:	JUMPGE T,DSKTS1		;AFTER PRINTING COMPARISON, IF DISK NOTICED ERROR
	X GSTS			; ALSO PRINT THAT
	JRST DSKTS1

DSKTS4:	DATAO LIGHTS,[0]
	JUMPGE B,DSKTS1
	MOVE A,B
	XOR A,CYLBUF(B)
	DATAO LIGHTS,A
	JRST DSKTS2

;SEEK TEST.  THIS LOOPS OVER ALL HEADS, AND OPTIONALLY LOOPS OVER DIFFERENT
; LENGTH SEEKS.  IT DOESN'T WRITE, BUT IS A TEST OF SEEKING AND SEARCHING.
;SETOM HCRASH IF YOU WANT TO DO NO ERROR RETRIES ON READ/SEARCH ERRORS
;(SEEK INCOMPLETES WILL ALWAYS BE RETRIED.)

SEKTST:	JSR INIT
	TYPE SEEK TEST UNIT #
	X NTYI
	 JRST SEKTST
	X CRR
	CAIL A,NUNITS
	 JRST SEKTST
	MOVE I,A
	X RESET
	TYPE ALWAYS DO FULL LENGTH SEEKS?
	SETZM SEKINC
	MOVEI A,10.*NBLKSC
	X Y.OR.N
	 MOVEM A,SEKINC'	;IF NO, DO DECREASING LENGTH SEEKS
SEKTS0:
RP,[
	MOVSI A,(DNOOPC)	;DETERMINE HOW MANY CYLINDERS THIS DRIVE
	DPB I,[DUNFLD A]
	DATAO DPC,A
	DATAI DPC,B
	MOVEI A,<NCYLS-1>*NBLKSC	;RP02
	TRNE B,2000
	 MOVEI A,<MCYLS-1>*NBLKSC	;RP03
];RP
.ELSE	MOVEI A,<NCYLS-1>*NBLKSC
IFN T300P,[
	CAIL I,T300P
	 MOVEI A,<NCYLS1-1>*NBLKC1	;T-300
];T300P
	MOVEM A,SEKCY2'
	SETZM SEKCY1'
SEKTS1:	SETZM SEKHDN'		;RESET HEAD
SEKTS2:	MOVE J,SEKCY1		;BLOCK ADDRESS OF OUTER CYLINDER
	ADD J,SEKHDN		;SELECT A BLOCK ON THE DESIRED HEAD
	MOVEI A,CYLBUF
	X READ			;READ IT
	SKIPGE T
SEKTS3:	 X GSTS			;JFCL THIS IF YOU DON'T WANT ERROR MESSAGES
	MOVE J,SEKCY2		;BLOCK ADDRESS OF INNER CYLINDER
	ADD J,SEKHDN		;SELECT SAME HEAD
	MOVEI A,CYLBUF
	X READ
	SKIPGE T
	 XCT SEKTS3
	PUSHJ P,TYIPSE
	MOVEI J,NSECS/SECBLK	;ADVANCE TO NEXT HEAD
	ADDB J,SEKHDN
	CAIGE J,NBLKSC		;SKIP IF TOUCHED ALL HEADS
	 JRST SEKTS2
	MOVN B,SEKINC		;YES, CHANGE CYLINDERS
	ADDB B,SEKCY2
	MOVE C,SEKINC
	ADDB C,SEKCY1
	CAMG C,B
	 JRST SEKTS1
	JRST SEKTS0		;RECYCLE

THWO:	PUSH P,A
	PUSH P,B
	TLNN A,-1
	 JRST THWO1
	HLRZS A
	X TOPT
	TYPE ,,
	HRRZ A,-1(P)
THWO1:	X TOPT
	POP P,B
	POP P,A
	POPJ P,
DC,[
	SUBTTL DC-10 PACK FORMATTING
MARK:	JSR INIT
	X CRR
	UNTMES FORMAT PACK ON UNIT #
	PUSHJ P,NTYI
	 JRST MARK
	CAIL A,NUNITS
	 JRST MARK
	PUSHJ P,CRR
	HRRZ TT,QTRAN(A)
	CONO DC1,(TT)		;SETUP DRIVE # FOR LATENCY TIMER
	MOVEM A,TOU
	MOVE I,A
	PUSHJ P,RECAL
	CONSO DC1,DFUNSF\DOFFL
	 JRST MARK1
	TYPE DRIVE OK?
	JRST CRDDT

MARK1:	MOVE A,[DSPC+DSCWIM+DSWIDX+DSWNUL]
	MOVEM A,CYLBUF
	MOVEI D,CYLBUF+1
	PUSHJ P,RDLAT		;READ LATENCY TIMER
	JUMPE A,.-1
MARK1A:	CONI DC1,A
	CONI DC1,C
	LDB A,[DSLAT A]
	LDB C,[DSLAT C]
	CAME A,C
	 JRST MARK1A
	JUMPN A,[MOVE B,A
		 JRST MARK1A]
IFN 0,[		;THIS HARDWARE HAS BEEN BROKEN FOR YEARS
	PUSH P,B
	MOVE A,B
	IDIVI A,10.		;NO. OF MILLISECONDS
	PUSH P,B
	PUSHJ P,TDPT
	MOVEI A,".
	PUSHJ P,TYO
	POP P,A
	ADDI A,"0
	PUSHJ P,TYO
	TYPE  MILLISECONDS ROTATION TIME
	PUSHJ P,CRR
	POP P,B
	CAIGE B,254.		;LIKELY JUST NO INDEX ON THIS PACK
	 JRST MARK1B
	TYPE TOO DAMN LONG TO BE CREDIBLE, USING 24.5 MS.
	PUSHJ P,CRR
];IFN 0
	MOVEI B,245.
MARK1B:	IMULI B,1000		;CONVERT TO NUMBER OF BITS/TRACK
	IDIVI B,36.		;NO. OF WORDS PER SECTOR
	AOJ B,
	MOVEM B,MAXT'
	SETZ A,
	PUSHJ P,STOBLK		;ENOUGH ONES TO WIPE OUT THIS TRACK
	MOVE J,MAXT
	IDIVI J,NSECS
	CAIL K,NSECS/2
	 AOJ J,			;INTER-SECTOR GAP LENGTH
	SUBI J,3+3+7+3011	;HEADER CODE+HEADER DATA+"ONES"+BLOCK+CHECKSUM
	MOVEI Q,NSECS
MARK1C:	MOVEI B,(D)
	HRLI B,HBLK		;SETUP COPYS FOR HEADER PREAMBLE,DATA,POSTAMBLE
	ADDI D,3
	BLT B,-1(D)
	MOVNI B,-NSECS(Q)
	IMULI B,3
	ADDI B,DHEDR
	HRRM B,-2(D)		;POINT COPY TO THIS SECTORS ENCODED DATA
	MOVEI B,103.		;103 BLOCKS OF 10 ZEROS (ENCODED)
	MOVE A,[QCOPY EZERS,15.,]
	PUSHJ P,STBLK
	SOJLE Q,MARK1D
	MOVE B,J		;ENOUGH ONES TO FILL OUT REMAINING PART OF SECTOR
	PUSHJ P,STOBLK
	JRST MARK1C

;SETUP STUFF FOR POSSIBLY WRITING READIN BLOCK
MARK1D:	MOVE A,[QCOPY EONES,3,]
	MOVEM A,(D)
	AOJ D,
	MOVSI A,(DOPR+DOHXFR)
	MOVEM A,(D)
	MOVEM D,RIWP'
	ADDI D,2
	MOVE B,J
	SUBI B,3+3+7+LRIBLK*3/2+3	;HEADER+LRIBLK+CHECKSUM
	LSH B,-1
	SUBI B,3*3
	PUSHJ P,STOBLK
	MOVEI B,(D)
	HRLI B,WRTRI
	ADDI D,5
	BLT B,-1(D)
	MOVSI A,(DJMP)		;PATCH JUMP AROUND RIBLK CODE, WILL BE CLOBBERED FOR BLOCK 0 ONLY
	ADDI A,(D)
	MOVE B,RIWP
	MOVEM A,1(B)
	MOVEI B,(D)
	MOVEM B,ENDP'
	AOS ENDP
	HRLI B,RCBLK
	ADDI D,5
	BLT B,-1(D)
	MOVEI B,-3(D)		;PATCH AOJN .-1 ADDRESS
	HRRM B,-2(D)
	TYPE PACK NO =
	PUSHJ P,DTYI
	PUSHJ P,CRR
	MOVE I,TOU
	MOVEM A,PKNUM(I)
	MOVE I,[440300,,RIHEDR]	;ENCODE READIN HEADER
	PUSHJ P,ENCI
	MOVEI I,RIHED0
	PUSHJ P,HCOMP
	MOVEI J,<NBLKS+XBLKS>/NSECS-1
	MOVEM J,TRKN'
;SO FAR
;WRITE IMAGE COMMAND - (START AT SECTOR PULSE)
;COPY <ENCODED ONES>	;ENOUGH TO WIPE OUT FULL TRACK
;(THEN FOR EACH SECTOR):

;HEADER PREAMBLE
;	ONES FOLLWED BY SINGLE ZERO
;	8 BYTES OF 10101
;	TWO 28 BIT HEADER WORDS
;	A SERIES OF ONES FOLLWED BY 01
;ENCODED ZEROS FOR DATA BLOCK (2004) WORDS + 2 WORDS CHECKSUM
;ENOUGH ENCODED ONES TO FILL OUT REST OF SECTOR (EXCEPT ON LAST SECTOR)

;AFTER LAST SECTOR
;A FEW ONES
;	NORMALLY:			FOR BLOCK 0:
;RIWP:	HANG FOR END OF TRANSFER	WRITE ONES
;	JUMP AROUND WRITE READIN	WRITE ONES
;					READIN HEADER PREAMBLE
;					READIN HEADER
;					READIN HEADER POSTAMBLE
;					READIN BLOCK
;					ONES TO PAD OUT REST OF TRACK
;	DALU SETUP CONTROL COUNTER
;ENDP:	READ COMPARE COMMAND
;	COPY 4 WORDS ZEROS
;	AOJN CC,.-1
;	HALT

MARK2:	MOVEI K,5
	MOVEM K,NTRYS'
	SETZM DHED0
	CAIL J,NBLKS/NSECS
	 JRST MARK2C
	MOVE I,TOU
	MOVE A,PKNUM(I)
	DPB A,[DPKID DHED0]		;PACK ID FOR HEADER
	DPB A,[DPKID @ENDP]		;PACK ID FOR READ-COMPARE COMMAND
	JUMPN J,MARK2C
	MOVE B,RIWP
	MOVE A,[QCOPY EONES,3,]
	MOVEM A,(B)
	MOVEM A,1(B)
MARK2C:	IDIVI J,NHEDS
	PUSH P,J
	MOVE W,TOU
	SKIPGE QTRAN(W)
	 ADDI J,NCYLS+XCYLS		;OFFSET IF DOUBLE SIZE PHYSICAL PACK
IRP A,,[CYLBUF,@ENDP,DHED0]		;SETUP INITIAL WRITE-IMAGE COMMAND
	DPB J,[DCYL A]			;  " READ-COMPARE COMMAND
	DPB K,[DSURF A]			;  " HEADER WORD
TERMIN
	POP P,J		;VIRTUAL CYLINDER #
	MOVEI W,0
	DPB W,[DHNXAD DHED1]
	MOVEI W,1			;END OF TRACK
	CAIN K,NHEDS-1
	 MOVEI W,2			;END OF CYLINDER
	CAIE J,NCYLS-1
	CAIN J,NCYLS+XCYLS-1
	 TRO W,1				;END OF DISK
	MOVE I,[440300,,DHEDR]
	PUSHJ P,ENCI
	MOVEI I,DHED0
	MOVEI Q,NSECS
MARK2B:	CAIN Q,1			;PUT IN INCREMENT CODE
	 DPB W,[DHNXAD DHED1]
	PUSHJ P,HCOMP			;ENCODE HEADERS
	AOS DHED0
	SOJG Q,MARK2B
MARK2A:	CONO DC0,DCCSET\DCDENB
	DATAO DC0,[DJMP CYLBUF]
	MOVE A,[DWLUP,,14]
	BLT A,16
	JRST 14		;WAIT IN AC'S FOR DISC, THEN FALL THRU
MARK2D:	CONSO DC0,DSSERR
	 JRST MARK4
	CONSZ DC1,DCPERR\DNXM\DDOBSY
	 JRST MARK3A
	CONSZ DC1,DPROT
	 JRST MARK3B
	CONSZ DC1,DOFFL\DFUNSF
	 JRST MARK3C
	CONSO DC1,DWTHER\DCKSER\DOVRRN\DRCER\DRLNER
	 JRST MARK3D
MTROV:	SOSLE NTRYS
	 JRST MARK2A
	CONSZ DC1,DOVRRN
	 JRST MARK3A
	TYPE DISK BAD
	JRST CRDDT

DWLUP:	CONSZ DC0,DSSACT
	 JRST 14
	JRST MARK2D

MARK3A:	TYPE MACHINE LOSSAGE
	JRST CRDDT

MARK3B:	TYPE NOT WRT ENABLED
	JRST CRDDT

MARK3C:	TYPE DRIVE LOSSAGE
	JRST CRDDT

MARK3D:	TYPE CONTROLLER LOSSAGE
	JRST CRDDT

MARK4:	SOSL J,TRKN
	 JRST MARK2
];DC

;INITIALIZE MFD AND TUT
; TOU AND PKNUM+n MUST BE ALREADY SET UP

MARK69:	MOVE I,TOU
	X MFDINN
	TYPE SWAPPING ALLOC =
	PUSHJ P,OTYI
	PUSHJ P,CRR
	X TUTINI
	MOVE A,PKNUM(I)
	MOVEM A,TUT+QPKNUM
	TYPE PACK # =
	X TDPT
	X CRR
	TYPE PACK ID =
	PUSHJ P,6TYI
	PUSHJ P,CRR
	MOVEM B,TUT+QPAKID
	MOVEI A,MFD
	MOVE J,MFDBK
	PUSHJ P,WRITT
	JUMPL T,WRERR
	MOVE A,TUT+QSWAPA	;SET UP FREE SPACE POINTER
	CAMGE A,NUDS
	 MOVE A,NUDS
	ADDI A,NBLKSC-1		;JUST IN CASE QSWAPA NOT ON CYLINDER BOUNDARY
	IDIVI A,NBLKSC
	IMULI A,NBLKSC
	MOVEM A,TUT+QTUTP
	MOVEI A,TUT
	PUSHJ P,WRTUT
	JUMPL T,WRERR
	JRST DDT

6TYI:	MOVE C,[440600,,B]
	MOVEI B,0
6TYL:	PUSHJ P,TYI
	SUBI A,40
	JUMPLE A,CPOPJ
	TLNE C,770000
	 IDPB A,C
	JRST 6TYL
DC,[
HCOMP:	SETOM HPAR'
	MOVEI J,(I)
	HRLI J,-2
HCOMP1:	MOVEI B,14.
	MOVE A,(J)
	XORM A,HPAR
	LSH A,-2
	SOJG B,.-2
	AOBJN J,HCOMP1

	MOVE B,(I)
	PUSHJ P,ENCH
	MOVE B,HPAR
	ANDI B,3
	LSH B,20.
	XORB B,1(I)
	PUSHJ P,ENCH
	MOVSI B,770000
HCOMP2:	TDNN B,DSKBP
	 POPJ P,
	PUSHJ P,ENCDO
	JRST HCOMP2

ENCO:	SKIPA A,C1
ENCZ:	 MOVEI A,0
ENC:	ANDI A,1
	HRRZ T,ENCS'
	JRST @ENCT(T)

ENCT:	ENC1
	ENC2
	ENC1
	ENCZ2

ENCDO:	SKIPA A,[3]
ENCDZ:	 MOVEI A,0
ENCD:	ANDI A,3
	HRRZ T,ENCS
	JRST @ENCDT(T)

ENCDT:	ENC2A
	[JRST 4,.]
	ENCZ2A
	[JRST 4,.]

ENC1:	HRLM A,ENCS
ENC1A:	AOS ENCS
	POPJ P,

ENC2:	ROT A,-1
	HLR A,ENCS
	ROT A,2
	JRST ENC2B
ENC2A:	LSH A,1
	AOS ENCS
ENC2B:	JUMPE A,ENC1A
C1:	TRO A,1
	IDPB A,DSKBP'
ENC3:	SETZM ENCS
	POPJ P,

ENCZ2:	ROT A,-1
	HLR A,ENCS
	JRST .+2
ENCZ2A:	 ROT A,-1
	ASH A,2
	TRO A,2
	IDPB A,DSKBP
	ROT A,2
	TRO A,5
	IDPB A,DSKBP
	JRST ENC3

ENCH:	LSH B,36.-28.
	SKIPA C,[14.]
ENCW:	 MOVEI C,18.
	LSHC A,2
	PUSHJ P,ENCD
	SOJG C,.-2
	POPJ P,

ENCI:	MOVEM I,DSKBP
	SETZM ENCS
	POPJ P,

RDLAT:	CONI DC1,A		;READ LATENCY TIMER INTO A
	LDB A,[DSLAT A]
RDLAT2:	MOVEM A,T
	CONI DC1,A
	LDB A,[DSLAT A]
	CAME A,T
	 JRST RDLAT2
	POPJ P,

STBLK:	MOVEM A,(D)		;STORE C(A) IN B WORDS AT D
	SOJLE B,[AOJA D,CPOPJ]
	HRLI D,1(D)
	ADDI B,1(D)
	MOVS D,D
	EXCH B,D
	BLT B,-1(D)
	POPJ P,

STOBLK:	MOVE A,[QCOPY EONES,LOBLK,]
	IDIVI B,LOBLK
	JUMPE B,STOBL3		;LESS THAN ONE BLOCK NEEDED??
	JUMPE C,STOBL2
	CAIL C,3
	 JRST STOBL2
	SOJ B,
	ADDI C,LOBLK
STOBL2:	PUSHJ P,STBLK
STOBL3:	CAIGE C,3
	 MOVEI C,3
	MOVNI C,(C)
	DPB C,[DCWC A]
	MOVEM A,(D)
	AOJA D,CPOPJ

HBLK:	QCOPY PREAMB,3,		;NORMAL HEADER
	QCOPY .,3,
	QCOPY POSTMB,7,

WRTRI:	QCOPY PREAMB,3,		;READIN HEADER, DATA BLOCK
	QCOPY RIHEDR,3,
	QCOPY POSTMB,7,
	QCOPY EZERS,<LRIBLK*3/2+3>,
	QCOPY EONES,3,

RCBLK:	DALU+DLCC+DLLB -401*NSECS(3)	;READ COMPARE "LOOP" FOR DATA WORDS
	DRCC
	QCOPY ZERS,4
	DJMP+DAOJNC .
	DHLT

LOBLK==60

DHED0:	0
DHED1:	-2004&37777
DHEDR:	BLOCK 3*NSECS


RIHED0:	0
RIHED1:	-LRIBLK&37777
RIHEDR:	BLOCK 3

EZERS:	REPEAT LRIBLK*3/2+3,252525252525

EONES:	REPEAT LOBLK+3,-1

PREAMB:	-1			;ONES
	-26			;ONES...0.1010
	655326553265		;1.10101.10101.10101.10101.10101.10101.10101

POSTMB:	REPEAT 6,-1		;ONES...01
	-3

ZERS:	BLOCK 4
];DC

RH,[
	SUBTTL RH-10 PACK FORMATTING

MARK:	JSR INIT
	SETZM CERRS
KL,[	SWPUA			;TURN THE CACHE OFF
	CONSZ APR,200000
	 JRST .-1
	CONI PAG,A
	TRZ A,600000
	CONO PAG,(A)
];KL
	X CRR
	UNTMES FORMAT PACK ON UNIT #
	X NTYI
	 JRST MARK
	CAIL A,NUNITS
	 JRST MARK
	X CRR
	MOVE I,A
	MOVEM I,TOU
	SETOM MARKF
	PUSHJ P,RESET
	SETZM MARKF
	TYPE ARE YOU SURE YOU WANT TO FORMAT PACK ON DRIVE #
	X TOPT
	TYPE ? 
	X TYI
	X CRR
	CAIE A,"Y
	 JRST DDT
	TYPE PACK NO =
	PUSHJ P,DTYI
	PUSHJ P,CRR
	MOVEM A,PKNUM(I)
	MOVSI A,%HRSER		;GET DRIVE SERIAL NUMBER
	PUSHJ P,RHGET
	 JRST RHMKER
	HRLZ D,A
	TLZ D,600000		;FIRST "KEY" WORD IS SERIAL NO OF DRIVE FORMATTED ON
	HRR D,PKNUM(I)		;SECOND "KEY" WORD IS I.T.S. PACK NUMBER
	SETZB A,B		;GENERATE PATTERN FOR SURFACE
RHFMP1:	MOVEM B,CYLBUF(A)	;CYL 0 TRACK 0 SECTOR (B) IS FIRST HEADER WORD
	MOVEM D,CYLBUF+1(A)	;PUT DRIVE SERIAL NUMBER IN 3.1-4.7 OF HDR WD 2
	ADDI A,2
	SETZB C,H		;FILL SECTOR WITH WORST CASE PATTERN
RHFMP2:	MOVE T,RHWC(H)
	MOVEM T,CYLBUF(A)
	AOS H
	CAIL H,RHWCL
	 MOVEI H,0
	AOS A
	CAIGE C,200-1	 
	 AOJA C,RHFMP2
	CAIGE B,NSECS-1		;DO NEXT SECTOR
	 AOJA B,RHFMP1
	CAIE A,202*NSECS
	 JRST 4,.		;WRONG AMOUNT OF CRUFT GENERATED
	MOVE A,[-202*NSECS_4,,CYLBUF-1] ;SET UP IOWD
	MOVEM A,SLVIOWD
	SETZM SLVIOWD+1
	MOVEI A,SLVIOWD
	MOVEM A,SLVICWA
	JRST RHFMT0		;GO FORMAT

RHWC:	726666666676		;RP04 10-MODE WORST CASE PATTERN
	555555555753
	333333337266
	666666765555
	555557533333
	333372666666
	667655555555
	573333333333
RHWCL==.-RHWC

RHMKER:	TYPE DISK ERROR
	X CRR
	PUSHJ P,GSTS
	JRST DDT

RHFMT0:	MOVEI J,NCYLS+XCYLS
RHFMT1:	SOJL J,RHFMT4		;LOOP ON CYLINDERS
	MOVEI K,NHEDS
RHFMT2:	SOJL K,RHFMT1		;LOOP ON SURFACES
	MOVEI B,NSECS		;ADJUST THE HEADER WORDS
	MOVEI C,0
RHFMT3:	DPB J,[221100,,CYLBUF(C)]
	DPB K,[100500,,CYLBUF(C)]
	ADDI C,202
	SOJG B,RHFMT3
	MOVSI A,%HRADR		;SET UP ADDRESS IN DRIVE
	DPB K,[$HATRK A]
	PUSHJ P,RHSET
	 JRST RHMKER
	MOVSI A,%HRCYL		;LEAVE CYLINDER NUMBER IN RH10 "DIB" LIGHTS
	HRR A,J
	PUSHJ P,RHSET
	 JRST RHMKER
	SETZM SLVICWA+1
	MOVSI A,%HRCTL		;SET UP WRITE HEADERS AND DATA COMMAND
	HRRI A,%HMWHD
	MOVEI B,SLVICWA
	DPB B,[$HCICWA A]
	PUSHJ P,RHSET
	 JRST RHMKER
	CONSO DSK,%HIDONE
	 JRST .-1
	CONSZ DSK,%HIERR
	 JRST RHMKER
	JRST RHFMT2

RHFMT4:	TYPE FORMATTING COMPLETE, VERIFICATION BEGINS
	X CRR
	MOVEI J,NCYLS+XCYLS-1
RHFMT5:	MOVEI A,CYLBUF
	PUSHJ P,READCY
	JUMPGE T,RHFMT6
	TYPE CYLINDER 
	MOVE A,J
	X TOPT
	TYPE  IN ERROR
	X CRR
	X GSTS
	X CRR
	JRST RHFMT9

RHFMT6:	SETZB A,H		;VERIFY DATA.  RELIES ON SECTOR SIZE BEING
RHFMT7:	MOVE B,CYLBUF(A)	; A MULTIPLE OF RHWCL
	CAME B,RHWC(H)
	 PUSHJ P,RHFMT8
	ADDI H,1
	CAIL H,RHWCL
	 MOVEI H,0
	CAIGE A,200*NSECS
	 AOJA A,RHFMT7
RHFMT9:	SOJGE J,RHFMT5
	SKIPN A,CERRS
	 JRST RHFMTX
	X TDPT
	TYPE  ECC-CORRECTED ERRORS DURING VERIFICATION.
RHFMTX:	X CRR
	JRST MARK69		;HARDWARE FORMATTED, DO SOFTWARE

RHFMT8:	PUSH P,A
	TYPE WORD 
	X TOPT
	TYPE  OF CYLINDER 
	MOVE A,J
	X TOPT
	TYPE  CORRECT 
	MOVE A,RHWC(H)
	X TOPT
	TYPE  ACTUAL 
	MOVE A,B
	X TOPT
	X CRR
	JRST POPAJ
];RH

RP,[
	SUBTTL RP-10 PACK FORMATTING

MARK:	JSR INIT
KL,[	SWPUA			;TURN THE CACHE OFF
	CONSZ APR,200000
	 JRST .-1
	CONI PAG,A
	TRZ A,600000
	CONO PAG,(A)
];KL
	X CRR
	UNTMES FORMAT PACK ON UNIT #
	X NTYI
	 JRST MARK
	CAIL A,NUNITS
	 JRST MARK
	X CRR
	MOVE I,A
	MOVEM I,TOU
	SETOM MARKF
	PUSHJ P,RESET
	SETZM MARKF
	MOVSI A,(DNOOPC)	;DETERMINE TYPE OF DRIVE
	DPB I,[DUNFLD A]
	DATAO DPC,A
	DATAI DPC,A
	MOVEI B,"2
	MOVEI C,NCYLS+XCYLS
	TRNN A,2000
	 JRST .+3
	  MOVEI B,"3
	  MOVEI C,MCYLS+XCYLS
	MOVEM C,LAST
	TLNE A,1
	 JRST [	TYPE WRITE HEADER LOCKOUT SWITCH IS ON
		JRST CRDDT ]
	TYPE ARE YOU SURE YOU WANT TO FORMAT PACK ON RP0
	MOVE A,B
	X TYO
	TYPE  #
	MOVE A,I
	X TOPT
	TYPE ? 
	X TYI
	X CRR
	CAIE A,"Y
	 JRST DDT
	TYPE PACK NO =
	PUSHJ P,DTYI
	PUSHJ P,CRR
	MOVEM A,PKNUM(I)
	SETZB A,B		;GENERATE TEMPLATE TRACK
RPFMP1:	MOVEI T,31.		;SYNC ZONE OF 30 ZERO WORDS
	SETZM CYLBUF(A)
	AOS A
	SOJG T,.-2
	AOS CYLBUF-1(A)		;AND ONE WORD CONTAINING 1 IN BIT 35
	MOVEM B,CYLBUF(A)	;THEN ADDRESS WORD
REPEAT 4,SETZM CYLBUF+1+.RPCNT(A) ;THEN ADDR PARITY WORD AND 3 ZERO WORDS SYNC
	ADDI A,5
	MOVE T,RPWC		;THEN 128 DATA WORDS OF WORST CASE PATTERN
	MOVEM T,CYLBUF(A)
	MOVSI T,CYLBUF(A)
	HRRI T,CYLBUF+1(A)
	BLT T,CYLBUF+177(A)
	ADDI A,200
	CAIGE B,NSECS-1		;DO NEXT SECTOR
	 AOJA B,RPFMP1
	CAIE A,244*NSECS
	 JRST 4,.		;WRONG AMOUNT OF CRUFT GENERATED
	MOVE A,[-244*NSECS,,CYLBUF-1] ;SET UP IOWD
	MOVEM A,SLVIOWD
	SETZM SLVIOWD+1
	MOVEI A,SLVIOWD
	MOVEM A,SLVICWA
	JRST RPFMT0		;GO FORMAT

RPMKER:	TYPE DISK ERROR
	X CRR
	PUSHJ P,GSTS
	JRST DDT

RPFMT0:	MOVE J,LAST		;HIGHEST CYLINDER # + 1
RPFMT1:	SOJL J,RPFMT4		;LOOP ON CYLINDERS
	MOVEI K,NHEDS
RPFMT2:	SOJL K,RPFMT1		;LOOP ON SURFACES
	MOVEI B,NSECS		;ADJUST THE HEADER WORDS
	MOVEI C,0
RPFMT3:	DPB J,[121100,,CYLBUF+37(C)]
	DPB K,[050500,,CYLBUF+37(C)]
	MOVE D,CYLBUF+37(C)	;COMPUTE HEADER PARITY WORD
	MOVEI T,36.
	MOVSI TT,(SETZ)		;ODD PARITY
RPFMTP:	TRNE D,1
	 TLC TT,(SETZ)
	ROT D,1
	SOJG T,RPFMTP
	MOVEM TT,CYLBUF+40(C)
	ADDI C,244
	SOJG B,RPFMT3
	MOVSI A,300000		;WRITE FORMAT
	ADDI A,SLVICWA
	DPB J,[DCYL A]
	ROT J,-8		;EXTRA BIT FOR RP03
	DPB J,[DCYLXB A]
	ROT J,8
	DPB K,[DSURF A]
	DPB I,[DUNFLD A]
	MOVEM J,RPIOCY
	PUSHJ P,SEEK
	 JRST RPMKER
	DATAO DPC,A
	CONSO DPC,DONE
	 JRST .-1
	CONSZ DPC,ALLER
	 JRST RPMKER
	JRST RPFMT2

RPFMT4:	TYPE FORMATTING COMPLETE, VERIFICATION BEGINS
	X CRR
	SOS J,LAST
RPFMT5:	MOVEI A,CYLBUF
	PUSHJ P,READCY
	JUMPGE T,RPFMT6
	TYPE CYLINDER 
	MOVE A,J
	X TOPT
	TYPE  DOESN'T READ -- GIVING UP ON IT.
	X CRR
	X GSTS
	X CRR
	JRST RPFMT9

RPFMT6:	SETZB A,H		;VERIFY DATA.
	MOVE D,RPWC
	LSH D,1			;CONTROL DROPS ONE BIT DURING WRITE FORMAT
RPFMT7:	MOVE B,CYLBUF(A)
	CAME B,D
	 PUSHJ P,RPFMT8
	CAIGE A,200*NSECS
	 AOJA A,RPFMT7
RPFMT9:	SOJGE J,RPFMT5
	X CRR
	JRST MARK69		;HARDWARE FORMATTED, DO SOFTWARE

RPFMT8:	PUSH P,A
	TYPE WORD 
	X TOPT
	TYPE  OF CYLINDER 
	MOVE A,J
	X TOPT
	TYPE  CORRECT 
	MOVE A,RPWC
	X TOPT
	TYPE  ACTUAL 
	MOVE A,B
	X TOPT
	X CRR
	JRST POPAJ

RPWC:	714533,,462556		;WORST CASE PATTERN
];RP
CONSTA
];NTS
NTS,[
SUBTTL MFDR - RECONSTRUCT MFD FROM UFDS

MFDR:	MOVEI P,PDL
	PUSHJ P,CRR	;RECONSTRUCT MFD BY GETTING NAMES FROM UFD'S
	UNTMES RECONSTRUCT MFD FROM UNIT #
	PUSHJ P,NTYI
	 JRST MFDR
	MOVE I,A
	PUSHJ P,MFDINN
	SETOM IMNFLG
	MOVEI J,0
MFDR1:	MOVEI A,TUT
	PUSHJ P,READ
	JUMPL T,MFDRL
	MOVE B,TUT+UDESCP	;LOOK LIKE LEGIT UFD?
	TLNE B,-1
	 JRST MRUFDL		;SHOULD BE F.S. PNTR
	CAIL B,<2000.-11.>*6
	 JRST MRUFDL
	MOVE B,TUT+UDNAMP
	SKIPE TUT+UDNAME	;USER NAME
	 TLNE B,-1
	  JRST MRUFDL		;PNTR TO BEG OF NAME AREA
	MOVEI B,(J)		;CONVERT BLOCK NO TO MFD INDEX
	SUB B,NUDS
	LSH B,1
	ADDI B,2000
	MOVE C,TUT+UDNAME	;USER NAME
	MOVEM C,MFD(B)
	AOSN IMNFLG
	 MOVEM B,MFD+MDNAMP
	JRST MRUFDW


MFDRL:	JRST 4,.+1
MRUFDL:	JFCL
MRUFDW:
	ADDI J,1
	CAMGE J,NUDS
	 JRST MFDR1
	TYPE WRITE?
	PUSHJ P,TYI
	CAIE A,"Y
	 JRST DDT
MFDWR:	MOVEI A,MFD
	MOVE J,MFDBK
	PUSHJ P,WRITE
	JRST DDT
];NTS

IMNFLG:	0

SUBTTL INITIALIZE MFD

MFDINN:	CLEARM MFD
	MOVE A,[MFD,,MFD+1]
	BLT A,MFD+1777
	MOVE A,[SIXBIT /M.F.D./]
	MOVEM A,MFD+MDCHK
	MOVE A,NUDS
	MOVEM A,MFD+MDNUDS
	MOVEI A,2000
	MOVEM A,MFD+MDNAMP
	POPJ P,

SUBTTL INITIALIZE TUT

;DRIVE NUMBER IN I, SWAPPING ALLOC IN A

TUTINI:	CLEARM TUT
	MOVE B,[TUT,,TUT+1]
	BLT B,TUT+<2000*MXTUTB>-1
	MOVEM A,TUT+QSWAPA
	MOVE K,A
	CAMGE K,NUDS
	 MOVE K,NUDS		;K HAS BASE OF FILE AREA
	MOVEI J,NBLKS		;DETERMINE HOW MANY BLOCKS THIS DRIVE
RP,[	MOVSI A,(DNOOPC)
	DPB I,[DUNFLD A]	;SELECT DRIVE
	DATAO DPC,A	
	DATAI DPC,A
	TRNE A,2000
	 MOVEI J,MBLKS		;RP03 HAS MORE BLOCKS
];RP
IFN T300P,[
	CAIL I,T300P
	 MOVEI J,NBLKS1
];T300P
	MOVEM J,TUT+QLASTB	;LAST REGULAR BLOCK IS LAST TUT'ED
IFN T300P,[
	MOVEI A,<2000*NTUTBL-LTIBLK>*TUTEPW
	CAIL I,T300P
	 MOVEI A,<2000*NTUTB1-LTIBLK>*TUTEPW
	SUB J,A
];T300P
.ELSE	SUBI J,<2000*NTUTBL-LTIBLK>*TUTEPW ;SUBTRACT MAX NUMBER OF TUTABLE BLOCKS
	CAMLE J,K		;IS THERE ROOM FOR ALL OF FILE AREA?
	 JRST 4,.		;NOPE
	SKIPGE J
	 MOVEI J,0
	MOVEM J,TUT+QFRSTB
	MOVEI A,TUT
TUTFIL:	MOVEI K,TUTLK		;ENTER HERE FROM SALV1, A -> TUT
	MOVSI D,440000+TUTBYT_6
	ADDI D,LTIBLK(A)
	MOVE B,NUDS
	SUB B,QFRSTB(A)
	JUMPLE B,TUTI1A
TUTI1:	IDPB K,D		;MARK OUT USER DIR AREA
	SOJG B,TUTI1

TUTI1A:	MOVEI B,(A)
	MOVSI D,-LSBTAB
TUTI2:	SKIPGE J,SBTAB(D)
	 JRST TUTI3		;NOT REALLY THERE
	PUSHJ P,TUTPNT
	MOVEI K,TUTLK
	DPB K,J			;MARK OUT BLOCK
TUTI3:	AOBJN D,TUTI2
	MOVE D,NTBL(I)		;MARK OUT TUT (SIZE VARIES)
TUTI4:	MOVE J,MFDBK
	SUB J,D
	PUSHJ P,TUTPNT
	MOVEI K,TUTLK
	DPB K,J
	SOJG D,TUTI4
	POPJ P,

;TUTPNT - ROUTINE TO ACCESS THE TUT
; CALL WITH BLOCK NUMBER IN J, POINTER TO TUT IN B
; RETURNS WITH BYTE POINTER IN J (0 IF BLOCK NOT TUT'ED)
; K IS CLOBBERED
;
;TUTPNN - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO NEW TUT ADDR
;
;TUTPNO - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO OLD TUT ADDR

TUTPNN:	SKIPA B,QNTUTO(I)

TUTPNO:	MOVE B,QOTUTO(I)

TUTPNT:	CAMGE J,QLASTB(B)
	CAMGE J,QFRSTB(B)
	 TDZA J,J
	  CAIA
	 POPJ P,		;BLOCK NOT TUT'ED, RETURN J=0
	SKIPGE QPKNUM(B)
	 JRST [ TYPE OLD FORMAT TUT?
		JRST ERRDDT ]
	SUB J,QFRSTB(B)
	IDIVI J,TUTEPW
	HLL J,QTTBL(K)
	ADDI J,LTIBLK(B)
	POPJ P,
SUBTTL MAIN SALVAGER

GOGO:	JRST GOGO0	;VECTOR OF MYSTERIES
SALVAG:	JRST GOGO1	;(IN CASE UP CREEK WITHOUT SYMBOL TABLE)
CHKR:	JRST CHKR0
NTS,[
	JFCL LPBUST	;-> LPT BUSTED FLAG
	JFCL NOQUES	;-> NO QUESTIONS FLAG
	JFCL GOODUN	;-> ONLY ROUTINE THAT KNOWS WHICH ARE "RIGHT" PACKS
	JFCL GETSTS	;-> ROUTINE TO TYPEOUT CURRENT DISK STATUS
	JFCL DSKTST	;-> SIMPLE READ/WRITE TEST
	JFCL SEKTST	;-> SIMPLE SEEK TEST (READ ONLY)
	JFCL DUP	;-> DISK COPYING ROUTINE
	JFCL HCRASH	;-> AS FAST AS POSSIBLE FLAG
];NTS

GOGO1:	JSR INIT
	SETOM NOQUES	;IF STARTED BY BEG$G IN ITS, BE FAST.
	JRST GOGO2	;(NO ROUTINE TYPEOUT)

GOGO0:	JSR INIT
GOGO2:	SETOM GOGOX	;AUTOMATIC MODE
	TYPE SALVAGER.
	MOVE A,[.FNAM2]
	X T6B
	X CRR
	MOVEI A,NUNITS-1
	SETOM QACT(A)	;ALL UNITS ACTIVE
	SOJGE A,.-1
	PUSHJ P,ACTUN	;ACTIVATE ALL UNITS THAT ARE ON-LINE
	PUSHJ P,GOODUN	;MAKE SURE ALL PACKS THAT SHOULD BE MOUNTED ARE
	MOVEM I,MDSK	;FIRST ACTIVE UNIT IS DSK TO GET MFD FROM
	MOVEM I,UDSK	;.. DSK TO GET UFD'S FROM
	PUSHJ P,DRPHAS	;VERIFY THAT DIRECTORIES ON ALL PACKS ARE IN PHASE
	SETZM CKFLSW	;DON'T CHECK ALL BLOCKS
	JRST SALV1

CHKR0:	JSR INIT	;ASK QUESTIONS MODE
	TYPE SALVAGER.
	MOVE A,[.FNAM2]
	PUSHJ P,T6B
	PUSHJ P,CRR
	MOVEI A,NUNITS-1
	SETZM QACT(A)
	SOJGE A,.-1
	TYPE ACTIVE UNITS ARE:
CHKR1:	PUSHJ P,NTYI
	 JRST CHKR2
	CAIGE A,NUNITS
	 SETOM QACT(A)
	JRST CHKR1

CHKR2:	PUSHJ P,CRR
	PUSHJ P,ACTUN
CHKR3:	UNTMES USE MFD FROM UNIT:
	PUSHJ P,NTYI
	 JRST CHKR3
	CAIGE A,NUNITS
	 SKIPN QACT(A)
	  JRST CHKR3
	MOVEM A,MDSK
	PUSHJ P,CRR
	PUSHJ P,DRPHAS	;VERIFY THAT DIRECTORIES ON ALL PACKS ARE IN PHASE
	SETZM CKFLSW
	SETZM CKFIX
DC,	TYPE CHECK FILES FOR CLOBBERED BLOCKS?
.ELSE	TYPE READ ALL BLOCKS OF ALL FILES?
	PUSHJ P,TYI
	CAIN A,"Y
	 SETOB A,CKFLSW
	PUSHJ P,CRR
	JUMPGE A,CHKR4
DC,[	TYPE FIX POINTERS THEN?
	SETOM CKFIX
	X Y.OR.N
	 SETZM CKFIX
];DC
CHKR4:	UNTMES GET USR DIRS FROM UNIT:
	PUSHJ P,NTYI
	 JRST CHKR4
	CAIGE A,NUNITS
	 SKIPN QACT(A)
	  JRST CHKR4
	PUSHJ P,CRR
	MOVEM A,UDSK
	JRST SALV1

ACTUN:	MOVEI C,NUNITS-1
ACTUN2:	SKIPN QACT(C)
	 JRST ACTUN1
	MOVE I,C
	PUSHJ P,RESET
	SKIPN QACT(C)	;STILL THERE?
	 JRST ACTUN1
	MOVE I,C
	MOVE A,QOTUTO(I)
	PUSHJ P,RDTUT
	JUMPL T,ACTUE1
	MOVE I,QOTUTO(C)
	MOVE A,QPKNUM(I)
	ANDI A,37
	MOVEM A,QPKN(C)
	SKIPE NOQUES
	 JRST ACTUN1
	TYPE UNIT #
	MOVE A,C
	PUSHJ P,DPT
	TYPE  ID IS 
	MOVE A,QPAKID(I)
	PUSHJ P,T6B
	TYPE  PK #
	MOVE A,QPKNUM(I)
	PUSHJ P,TDPT
IFN DC10P+RH10P,[
	MOVE A,PKNUM(C)
	CAMN A,QPKNUM(I)
	 JRST ACTUN4
IFN T300P,[
	CAIL C,T300P
	 JRST ACTUN4		;PKNUM NOT REALLY SET UP
];T300P
	TYPE  (HARDWARE SAYS 
	PUSHJ P,TDPT
	TYPE )
ACTUN4:	]
	SKIPN A,QTRSRV(I)
	 JRST ACTUN5
	CAMN A,[-1]
	 JRST [	TYPE  (RESERVED)
		JRST ACTUN5 ]
	PUSHJ P,TSPAC
	PUSHJ P,SIXTYP
	TYPE :
ACTUN5:	PUSHJ P,CRR
ACTUN1:	SOJGE C,ACTUN2
	SETOM ACTIVE
	POPJ P,

ACTUE1:	TYPE Error reading TUT block
	PUSHJ P,CRR
	PUSHJ P,GSTS
	JRST ERRDDT

ACTUE3:	TYPE Error reading MFD block
	PUSHJ P,CRR
	PUSHJ P,GSTS
	JRST ERRDDT
ACTIVE:	0		;-1 IF ALREADY HAVE RESET DRIVES

;MAKE SURE ALL NECESSARY PACKS ARE MOUNTED
GOODUN:
NTS,[	MOVEI A,FIRSPK	;AND RETURN MASTER DISK # IN I
GOODN1:	MOVEI C,NUNITS-1
GOODN2:	SKIPE QACT(C)
	 CAME A,QPKN(C)
	  SOJGE C,GOODN2
	JUMPL C,GOODN3	;THIS PACK MISSING
	CAIGE A,LASTPK
	 AOJA A,GOODN1
	MOVEI A,LASTPK-FIRSPK+1	;NUMBER OF PRIMARY PACKS
	MOVEI C,NUNITS-1	;SCAN FOR SECONDARY PACKS
GOODN4:	SKIPN QACT(C)
	 JRST GOODN5
	MOVE B,QOTUTO(C)
	SKIPE B,QTRSRV(B)
	 CAMN B,[-1]
	  JRST GOODN5
	ADDI A,1		;THIS SECONDARY PACK IS OK TO HAVE MOUNTED	 
GOODN5:	SOJGE C,GOODN4
];NTS
	MOVEI C,NUNITS-1	;AND FIND MASTER DISK (LOWEST NUMBERED ACTIVE UNIT)
	SKIPE QACT(C)		;ALSO COMPUTE GOOD PACKS - ALL PACKS IN A
	 JRST [	MOVE I,C
		SOJA A,.+1 ]
	SOJGE C,.-2
NTS,	JUMPGE A,CPOPJ
NTS,	TYPE EXTRA PACKS MOUNTED.
NTS,	JRST ERRDDT
TS,	POPJ P,

GOODN3:	TYPE PACK #
	X TDPT
	TYPE  NOT MOUNTED
	JRST ERRDDT

TS, DRPHAS: POPJ P,
NTS,[
;CHECK THAT DIRECTORIES ARE IN PHASE ON ALL PACKS
DRPHAS:	MOVEI I,NUNITS-1
DRPHS1:	SKIPN QACT(I)		;FIRST, GET ALL THE MFDS
	 JRST DRPHS2
	MOVE J,MFDBK
	MOVE A,QNTUTO(I)
	PUSHJ P,READ
	JUMPL T,ACTUE3
DRPHS2:	SOJGE I,DRPHS1
	MOVE I,MDSK		;GET MASTER DISK'S ASCENDING DIRECTORY NUMBER
	MOVE A,@QNTUTO(I)	.SEE MDNUM
	MOVE B,A
	SUBI B,1
	MOVEI I,NUNITS-1	;SEE IF ALL OTHERS ARE THE SAME, OR AT MOST 1 LESS
DRPHS3:	SKIPE QACT(I)
	 JRST [	CAMG B,@QNTUTO(I) .SEE MDNUM
		 CAMGE A,@QNTUTO(I) .SEE MDNUM
		  JRST DRPHS6
		JRST .+1 ]
	SOJGE I,DRPHS3
	POPJ P,

DRPHS6:	TYPE DIRECTORIES OUT OF PHASE.
	X CRR
	MOVEI I,0
DRPHS4:	SKIPN QACT(I)
	 JRST DRPHS5
	UNTMES UNIT #
	HRRZ A,I
	X TOPT
	TYPE  PACK #
	MOVE A,QPKN(I)
	X TDPT
	TYPE , MDNUM=
	MOVE A,@QNTUTO(I)	.SEE MDNUM
	X TOPT
	X CRR
DRPHS5:	CAIGE I,NUNITS-1
	 AOJA I,DRPHS4
	TYPE VERIFY THAT THE PROPER PACKS ARE MOUNTED.  IF YOU AREN'T SURE,
	X CRR
	TYPE GET HELP.  IF THEY ARE PROPER, AND ONE IS JUST COMING ON-LINE
	X CRR
	TYPE AFTER BEING OFF FOR A WHILE, YOU WILL HAVE TO UCOP TO IT.
	SKIPE GOGOX
	 JRST ERRDDT
	JRST CRR
];NTS

SALV1:	SETZM MFDWRT	;-1 IF MFD MODIFIED (DIRECTORIES DELETED)
	SETZM SHARED
	MOVEI I,NUNITS-1
SALV2:	SKIPN QACT(I)
	 JRST SALV3
	HRRZ B,QNTUTO(I)	;ZERO OUT NEW TUT
	HRL B,B
	SETZM (B)
	MOVE A,B
	AOS B
	BLT B,2000*MXTUTB-1(A)
	HRRZ B,QNTUTO(I)	;COPY RANDOM INFO FROM OLD TUT TO NEW
	HRL B,QOTUTO(I)
	MOVE A,B
	BLT A,LTIBLK-1(B)
	HRRZ A,QNTUTO(I)
	PUSHJ P,TUTFIL		;FILL IN BLOCKS AREA OF TUT
SALV3:	SOJGE I,SALV2
	MOVE I,MDSK
	MOVEI A,MFD
	MOVE J,MFDBK
	PUSHJ P,READ
	JUMPL T,ACTUE3
	MOVE A,MFD+MDNUDS
	CAME A,NUDS
	 JRST [	TYPE Wrong NUDSL version =
		X TDPT
		JRST ERRDDT]
	MOVE A,MFD+MDCHK
	CAME A,[SIXBIT /M.F.D./]
	 JRST [	TYPE MFD check word garbaged? 
		X T6B
		X CRR
		SKIPN GOGOX
		X CONTIN
		 JRST ERRDDT
		JRST .+1]
	MOVE Q,MFD+MDNAMP
	ADDI Q,MFD
MFDLUP:	CAIL Q,MFD+2000
	 JRST MFDFIN
	SKIPN A,MNUNAM(Q)
	 JRST MFDLU1
	PUSHJ P,USRLUP
	SKIPN LFILES
	 PUSHJ P,DELUSR
MFDLU1:	ADDI Q,LMNBLK
	JRST MFDLUP

DELUSR:	MOVE A,MNUNAM(Q)
	CAMN A,[SIXBIT /.LPTR./]
	 POPJ P,
	PUSHJ P,T6B
	TYPE ; NO FILES, USER DIRECTORY DELETED
	PUSHJ P,CRR
	SETZM MNUNAM(Q)
	SETOM MFDWRT
	POPJ P,

USRLUP:	MOVEM A,USRNAM
	SETZM UFDLOS
	SETZM UFDSEE			;-1 IF ANY ERROR OCCURS, PRINT WHOLE UFD
	SETZM LFILES
	MOVE J,Q
	SUBI J,MFD+2000			;MAP MFD ENTRY INTO UFD BLOCK
	IDIVI J,LMNBLK			; -Nth USER DIRECTORY
	ADD J,NUDS			;END OF USER DIR AREA - N
	PUSH P,Q
	PUSH P,UDSK			;SAVE UFD DISK, MIGHT CHANGE IF UFD IS BAD
	MOVEM J,DBLK
	MOVE I,UDSK
USRLU1:	MOVEI A,OUSRD			;COME BACK TO HERE ON TRY NEXT DRIVE
	PUSHJ P,READ
	JUMPL T,USRLE2
	MOVE Q,OUSRD+UDNAME
	CAME Q,USRNAM
	 JSR USRLE4
	MOVE Q,[OUSRD,,NUSRD]
	BLT Q,NUSRD+1777		;COPY OLD FOR GARBAGE CHECK
	MOVEI Q,2000-LUNBLK+OUSRD
	MOVEI J,OUSRD
	ADD J,UDNAMP(J)			;LOWEST FILE NAME BLOCK
	CAIG J,OUSRD+2000
	CAIGE J,OUSRD+UDDESC
	 JRST USRLE3			;NAME POINTER OUTSIDE BLOCK! (try next drive)
	MOVE T,OUSRD+UDESCP
	IDIVI T,6
	ADDI T,OUSRD+UDDESC
	CAML T,J
	 JRST USRLE7		;NAME AND DESCRIPTOR AREAS OVERLAP (try next drive)
	PUSH P,J		; FILE NAME POINTER

;PER FILE LOOP
DIRL1:	CAMGE Q,J
	 JRST USRFIN
	SETOM FILEER		; PRINT FILE NAME ONLY ON FIRST ERROR
	SETZM BADFIL		; SET IF BAD RETRIEVAL DISCOVERED
	MOVEM Q,LASTQ
	SKIPN A,UNFN1(Q)
	SKIPE UNFN2(Q)
	 CAIA
	  JRST DIRLUP
	AOS LFILES
	LDB C,[UNPKN UNRNDM(Q)]
	LDB A,[UNDSCP UNRNDM(Q)]
	CAML A,OUSRD+UDESCP
	 JRST DIRLE1		;POINTS OUTSIDE DESC AREA (ignore)
	IDIVI A,6
	ADDI A,OUSRD+UDDESC
	HLL A,QBTBLI(B)
	TLNE A,400000
	 SUB A,[440000,,1]
	MOVEI ZR,0
	LDB B,A
	JUMPN B,DIRLE2		;NOT PRECEEDED BY ZERO (ignore)
DIRL2:	MOVE N,A
	MOVEI J,0
	ILDB B,A
	JUMPE B,DIRLE3		;POINTS TO ZERO (ignore)
DIRL3:	MOVE TT,UNRNDM(Q)
	TLNE TT,UNLINK
	 JRST LINK
	SETZM NOTUT
	PUSHJ P,FINDPK		;FIND WHICH PACK
	SKIPL C
	 SKIPN QACT(C)
	  SETOM NOTUT		;FILE ON UNMOUNTED PACK, DON'T HACK TUT
	MOVEM C,FUNIT
	SETZM LSTBLK
	SETZM ADRSET
TRLUP:	MOVE TT,N
	ADDI TT,NUSRD-OUSRD
	IDPB ZR,TT
	ILDB B,N
	JUMPE B,DIRLUP
	CAIN B,UDWPH	; WRITE PLACE HOLDER, OR NULL FILE
	 JRST TRLUP
	CAIL B,UDWPH
	 JRST LOAD
	CAILE B,UDTKMX
	 JRST SKIPF
	JRST TLUP

TLUP:	AOS Q
TLUP1:	MOVE A,Q
	SKIPN ADRSET
	 JRST DIRLE4		;NO STARTING BLOCK (ignore untill jmp)
	SKIPE NOTUT		;IF NOT ON ACTIVE UNIT, SKIP FILE
	 JRST CKFL3
	MOVE D,QOTUTO(C)
	CAML A,QLASTB(D)
	 JRST DIRLE5		;BLOCK OFF DSK (ignore block)
	CAMGE A,QFRSTB(D)
	 JRST DIRLE5
	CAMGE A,NUDS
	 JRST DIRLE6		;POINTS TO UFDS (ignore block)
CKFL2A:	MOVSI D,-LSBTAB
	CAMN A,SBTAB(D)
	 JRST DIRLE6		;SPECIAL BLOCK
	AOBJN D,.-2
	MOVE D,MFDBK
	SUB D,NTBL(C)
	CAML A,D
	 CAMLE A,MFDBK
	  CAIA
	   JRST DIRLE6		;TUT
NTS,[	SKIPGE CKFLSW
	 PUSHJ P,CKFL
];NTS
	MOVEM Q,LSTBLK
	SKIPN NOTUT
	 SKIPN ADRSET
	  JRST CKFL3
	MOVE D,J	;SEE IF BLOCK LOCKED
	SUBI D,NTUT0-OTUT0 ;(LOCK BYTES NOT IN NEW TUT YET)
	ILDB D,D
	CAIN D,TUTLK
	 PUSHJ P,DIRLEB
	ILDB D,J
	SKIPE D
	 JSR DIRLE7	;SHARED BLOCK
	CAIGE D,TUTMNY
	 AOS D
	DPB D,J
	MOVE K,J
	SUBI K,NTUT0-OTUT0
	LDB D,K
	JUMPE D,DIRLE9
CKFL3:	SOJG B,TLUP
	JRST TRLUP

OLDFIL:	SETOM UFDSEE		;PRINT WHOLE UFD LATER
	AOSE FILEER
	 JRST CKFL2A
	TYPE !!! Over-writing user-directory area block 
	MOVE A,Q
	X DPT
	TYPE , BY 
	X PNTNAM
	JRST CKFL2A


CKFL:	PUSH P,J
	PUSH P,I
	SETOM XWDSEE
	MOVE J,A
	MOVEI A,FDBUF
	MOVE I,C
	PUSHJ P,READ
CKFLBP:	JUMPL T,CKFLE1
CKFL4:
DC,[	MOVE A,RXWDS+XWSYSN
	CAME A,USRNAM
	JRST CKFLE2
CKFL5:	LDB A,[XWBLK RXWDS]
	CAME A,LSTBLK
	JRST CKFL6
CKFL6A:	SKIPE CKFIX			;FIX ERRORS?
	SKIPGE XWDSEE			;ANY ERRORS?
	JRST CKFL7
	LDB A,[XWAWC RXWDS]
	DPB A,[XWAWC WXWDS]
	MOVE A,LSTBLK
	DPB A,[XWBLK WXWDS]
	MOVE A,USRNAM
	MOVEM A,WXWDS+XWSYSN
	MOVE Q,LASTQ
	MOVE A,UNFN1(Q)
	MOVEM A,WXWDS+XWFN1
	MOVE A,UNFN2(Q)
	MOVEM A,WXWDS+XWFN2
	MOVEI A,FDBUF
	PUSHJ P,WRITE
	MOVEI A,FDBUF
	PUSHJ P,READ
	JUMPL T,CKFLE1
	LPR RETRIEVAL NOW:
	PUSHJ P,LPTXWD
	SETOM XWDSEE
	JRST CKFL4
];DC
CKFL7:	POP P,I
	POP P,J
	POPJ P,

CKFLE1:	PUSHJ P,PNTNAM
	TYPE ERROR READING BLOCK 
CKFLE3:	MOVE A,J
	PUSHJ P,DPT
	PUSHJ P,CRR
	PUSHJ P,PNTXWD
	PUSHJ P,GSTS
	JRST CKFL4
DC,[
CKFLE2:	JRST CKFL6A		;JFCL THIS IF YOU HATE ARCHIVES
	AOS BADFIL
	PUSHJ P,LPTNAM
	X LTAB
	X LPTXWD
	X LTAB
	LPR Retrieval User-name differs
	LDB A,[XWBLK RXWDS]
	CAMN A,LSTBLK
	JRST [	X LCRR
		JRST CKFL6A]
	LPR , 
	JRST CKFLE4

CKFL6:	JRST CKFL6A		;JFCL THIS IF YOU HATE ARCHIVES
	AOS BADFIL
	PUSHJ P,LPTNAM
	X LTAB
	X LPTXWD
	X LTAB
CKFLE4:	LPR Chain pointer wrong, Last block=
	MOVE A,LSTBLK
	PUSHJ P,LOPT
	PUSHJ P,LCRR
	JRST CKFL6A
];DC

LOAD:	SETOM ADRSET		;B HAS BYTE WHERE  UDWPH < BYTE <=77
	ANDCMI B,20		;DM FUNNY BITS
	MOVEI J,-UDWPH-1(B)
	MOVEI K,NXLBYT
LOAD1:	MOVE TT,N
	ADDI TT,NUSRD-OUSRD
	IDPB ZR,TT
	ILDB B,N
	LSH J,6
	ADD J,B
	SOJG K,LOAD1
	MOVE Q,J
	SKIPE NOTUT
	 JRST LOAD2		;THIS DRIVE NOT ACTIVE
	MOVE I,C
	PUSHJ P,TUTPNN		;GET POINTER TO NEW TUT
	ADD J,[TUTBYT_14,,]	;BACK UP FOR ILDB
LOAD2:	MOVEI B,1
	JRST TLUP1

SKIPF:	SUBI B,UDTKMX
	IBP J
	AOS Q
	SOJG B,.-2
	MOVEI B,1
	JRST TLUP

LINK:	MOVE TT,N
	ADDI TT,NUSRD-OUSRD
	PUSHJ P,LTYPE
	 JRST DIRLEC
	PUSHJ P,LTYPE
	 JRST DIRLEC
	PUSHJ P,LTYPE
	 JRST DIRLUP
	ILDB B,N
	JUMPE B,DIRLUP
	JRST DIRLE8		;LINK NOT FOLLOWED BY ZERO (ignore)

LTYPE:	MOVEI B,6
LTYPE2:	IDPB ZR,TT
	ILDB A,N
	JUMPE A,CPOPJ		;NON SKIP RETURN IF FOLLOWED BY ZERO
	CAIN A,':
	 JRST [	ILDB A,N
		IDPB ZR,TT
		JRST LTYPE3]
	CAIE A,';
LTYPE3:	 SOJG B,LTYPE2
	JRST POPJ1		;SKIP RETURN IF ENDS NATURALLY

DIRLUP:	SKIPN BADFIL
	 JRST DIRLP1
	TYPE BAD RETRIEVAL: 
	X PNTNAM
DIRLP1:	MOVE Q,LASTQ
	MOVE J,(P)
	MOVSI A,UNMARK
	ANDCAM A,UNRNDM(Q)
	SUBI Q,LUNBLK
	JRST DIRL1

FINDPK:	PUSH P,B		;MAP PACK NUMBER IN C, TO UNIT NUMBER
	MOVEI B,NUNITS-1
	CAMN C,QPKN(B)
	 JRST FINDP1
	SOJGE B,.-2
	SETOM C
	POP P,B
	POPJ P,

FINDP1:	HRRZ C,B
	POP P,B
	POPJ P,

USRLE2:	TYPE USR DIRECTORY READ ERROR
	SETOM FLAG'		;HARDWARE ERROR
USRL2A:	PUSHJ P,TSPAC
	MOVE A,USRNAM
	PUSHJ P,SIXTYP
	MOVEI A,";
	PUSHJ P,TYO
	PUSHJ P,CRR
	SKIPE FLAG
	 PUSHJ P,GSTS		;PRINT CONTROLLER STATUS
	SKIPE GOGOX
	 JRST ERRDDT
	TYPE TRY NEXT DRIVE?
	PUSHJ P,TYI
	CAIE A,"Y
	 JRST CRDDT
	PUSHJ P,CRR
	MOVE I,UDSK
USRL2B:	AOS I
	CAIL I,NUNITS
	 SUBI I,NUNITS
	SKIPN QACT(I)
	 JRST USRL2B
	MOVEM I,UDSK	;WILL GET POPED BEFORE NEXT USER
	SETOM UFDLOS	;CAUSE DIR TO BE WRITTEN ON ALL DRIVES
	MOVE J,DBLK
	JRST USRLU1

USRLE3:	TYPE User directory name-pointer scrambled
	SETZM FLAG
	JRST USRL2A

USRLE7:	TYPE Name area, descriptor area overlap
	SETZM FLAG
	JRST USRL2A

USRLE4:	0	;USR NAME IN DIR DIFFERS
	TYPE USER NAME IN DIRECTORY DIFFERS
	PUSHJ P,TSPAC
	MOVE A,USRNAM
	PUSHJ P,T6B
	TYPE ; BLOCK 
	MOVE A,DBLK
	X DPT
	UNTMES , UNIT 
	MOVE A,I
	PUSHJ P,DPT
	TYPE , DIR HAS
	X TSPAC
	MOVE A,OUSRD+UDNAME
	X T6B
	PUSHJ P,CRR
	SKIPE GOGOX
	 JRST ERRDDT
	TYPE CORRECT IT? (MFD ENTRY TAKEN AS GOOD)
	PUSHJ P,TYI
	X CRR
	CAIE A,"Y
	 JRST ERRDDT
	MOVE A,USRNAM
	MOVEM A,OUSRD+UDNAME
	MOVEI A,OUSRD
	PUSHJ P,WRITE
	JRST @USRLE4

USRLE5:	SETOM UFDSEE
	SKIPN GARBF
	 PUSHJ P,PGARBF
	LPR , POINTER=
	MOVE A,Q
	PUSHJ P,LOPT
	LPR , GARBAGE IS 
	MOVE A,NUSRD(Q)
	ANDCAM A,OUSRD(Q)	;CLEAR OUT THE GARBAGE
	PUSHJ P,LOPT
	PUSHJ P,LCRR
	AOJA Q,GARB6

PGARBF:	LPR GARBAGE IN FREE AREA
	PUSHJ P,LCRR
	MOVE A,USRNAM
	PUSHJ P,L6B
	LPR ; Block #
	MOVE A,DBLK
	PUSHJ P,LOPT
	PUSHJ P,LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDLOS
	SETOM GARBF
	POPJ P,

USRLE6:	SETOM UFDSEE
	SKIPN EXGARB
	 PUSHJ P,PEXGAR
	MOVE A,J
	PUSHJ P,LOPT
	PUSHJ P,LSPAC
	MOVE A,B
	PUSHJ P,LOPT
	PUSHJ P,LCRR
	MOVE TT,Q
	SUBI TT,NUSRD-OUSRD
	DPB ZR,TT
	JRST GARB3

PEXGAR:	LPR EXTRA GARBAGE IN UFD
	PUSHJ P,LCRR
	MOVE A,USRNAM
	PUSHJ P,L6B
	LPR ; Block #
	MOVE A,DBLK
	PUSHJ P,LOPT
	PUSHJ P,LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDLOS
	SETOM EXGARB
	POPJ P,


PNTNAM:	PUSH P,NOLPT
	SETOM NOLPT
	X LPTNAM
	POP P,NOLPT
	POPJ P,

LPTNAM:	PUSH P,A		;DIRLE5 ETC.
	MOVE A,USRNAM
	PUSHJ P,L6B
	MOVEI A,";
	PUSHJ P,LTYO
	CAIA
LPTFIL:	 PUSH P,A		;AVOID PDL SCREWAGE
	PUSH P,B
	PUSH P,C
	MOVE B,LASTQ
	MOVE A,UNFN1 (B)
	PUSHJ P,L6B
	PUSHJ P,LSPAC
	MOVE A,UNFN2(B)
	PUSHJ P,L6B
	LDB C,[UNPKN UNRNDM(B)]
	LPR   PACK 
	MOVE A,C
	X LDPT
	X FINDPK			;FIND PACK FILE IS ON
	JUMPL C,LPTFI1
	LPR , UNIT #
	MOVE A,C
	X LDPT
LPTFI1:	PUSHJ P,LCRR
	INSIRP POP P,[C B A]
	POPJ P,

PNTXWD:	PUSH P,NOLPT
	SETOM NOLPT
	X LPTXWD
	POP P,NOLPT
	POPJ P,

LPTXWD:
DC,[
	PUSH P,A
	LPR Extra words: Block #
	MOVE A,UNIT
	X LDPT
	MOVEI A,"-
	X LTYO
	MOVE A,BLK
	X LOPT
	X LSPAC
	MOVE A,RXWDS+XWSYSN
	PUSHJ P,L6B
	MOVEI A,";
	PUSHJ P,LTYO
	MOVE A,RXWDS+XWFN1
	PUSHJ P,L6B
	PUSHJ P,LSPAC
	MOVE A,RXWDS+XWFN2
	PUSHJ P,L6B
	LPR , Chain pointer=
	LDB A,[XWBLK RXWDS]
	PUSHJ P,LOPT
	LPR , active wd cnt=
	LDB A,[XWAWC RXWDS]
	PUSHJ P,LOPT
	PUSHJ P,LCRR
	POP P,A
];DC
	SETZM XWDSEE		.SEE CKFL6A
	POPJ P,
DIRLE1:	PUSHJ P,LPTNAM
	LPR DESC POINTS OUT OF DESC AREA
	PUSHJ P,LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDSEE
	JRST DIRLUP

DIRLE2:	PUSHJ P,LPTNAM
	LPR FILE NOT PRECEEDED BY ZERO
	PUSHJ P,LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDSEE
	JRST DIRL2

DIRLE3:	PUSHJ P,LPTNAM
	LPR FILE POINTS TO ZERO
	PUSHJ P,LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDSEE
	JRST DIRL3

DIRLE4:	PUSHJ P,LPTNAM
	LPR STARTING ADDRESS NOT SET
DIRL4A:	X LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDSEE
	JRST CKFL3

DIRLE5:	PUSHJ P,LPTNAM
	LPR BLOCK POINTS OFF DSK 
	X LOPT
	JRST DIRL4A

DIRLE6:	PUSHJ P,LPTNAM
	LPR BLOCK IN RESERVED AREA 
	X LOPT
	JRST DIRL4A

DIRLE7:	0
	PUSHJ P,LPTNAM
	LPR SHARES BLOCK WITH SOME OTHER FILE
	X LCRR
	AOS SHARED	;SHARED BLOCK FLAG
;	SKIPN NOLPT
;	 SETOM UFDSEE
	SETZM SALVRT	;NO AUTOMATIC SYS START
	JRST @DIRLE7

DIRLEC:	PUSHJ P,LPTNAM
	LPR LINK NOT THREE NAMES
	JRST DIRLED

DIRLE8:	PUSHJ P,LPTNAM
	LPR LINK NOT FOLLOWED BY A ZERO
DIRLED:	PUSHJ P,LCRR
	SKIPE GOGOX
	 JRST ERRDDT
	SETOM UFDSEE
	JRST DIRLUP

DIRLE9:	SKIPE NOQUES
	 JRST CKFL3
	LPR FILE UNPROTECTED IN OLD TUT - 
	X LPTNAM
	LPR Block 
	MOVE A,Q
	X LOPT
	X LCRR
	JRST CKFL3

DIRLEB:	PUSHJ P,LPTNAM
	LPR FILE CONTAINS LOCKED BLOCK 
	MOVE A,Q
	X LOPT
	SETZM SALVRT		;NO AUTO SYS STARTUP
	JRST LCRR

USRFIN:	CLEARM GARBF
	CLEARM EXGARB
	CLEARB ZR,J
	MOVE Q,[440600,,NUSRD+UDDESC]
GARB2:	CAML J,OUSRD+UDESCP
	 JRST USRFN2
GARB4:	ILDB B,Q
	JUMPN B,USRLE6		;GARBAGE IN DESCRIPTOR AREA (clear out)
GARB3:	AOJA J,GARB2

USRFN2:	TLNE Q,770000
	 JRST GARB4
	MOVEI Q,-NUSRD+1(Q)	;FIRST WORD ABOVE DESCRIPTOR AREA
GARB6:	CAML Q,NUSRD+UDNAMP
	 JRST GARB5
	SKIPN NUSRD(Q)
	 AOJA Q,GARB6
	JRST USRLE5		;GARBAGE IN NAME AREA (clear out)
	
GARB5:	SKIPE UFDSEE
	 PUSHJ P,UFDPR
	SKIPN UFDLOS
	 JRST USRFN5
	SKIPE NOQUES
	 JRST GARB5A
	TYPE UFD NEEDS UPDATE - WRITE? 
	X Y.OR.N
	 JRST USRFN5
GARB5A:	MOVEI A,OUSRD
	MOVEI I,NUNITS-1
	MOVE J,DBLK
GARB7:	SKIPE QACT(I)
	 PUSHJ P,WRITE
	SOJGE I,GARB7
USRFN5:	POP P,J
	POP P,UDSK
	POP P,Q
	POPJ P,


SUBTTL LISTF - DUMP OUT USER DIRECTORY
LISTF:	JSR INIT
	SKIPL ACTIVE		;ALREADY DID RESET
	 X ACTUN
	X CRR
	TYPE USER?=
	X SIXIN
	X CRR
	JUMPE B,DDT
	MOVEI I,NUNITS-1
	SETOM FUNIT
LISTF3:	SKIPN QACT(I)
	 JRST LISTF2
	MOVEM I,FUNIT
	MOVE A,QNTUTO(I)
	PUSHJ P,RDTUT
	JUMPL T,[TYPE ERROR READING TUT #
		MOVE A,I
		X DPT
		X CRR
		X GSTS
		X CONTIN
		JRST DDT
		JRST .+1]
LISTF2:	SOJGE I,LISTF3
	MOVEM B,USRNAM
	MOVEI A,MFD
	MOVE J,MFDBK
	SKIPGE I,FUNIT		;USE FIRST ACTIVE UNIT
	 JRST LISTF4		;NO DISKS ACTIVE??
	X READ
	JUMPL T,[TYPE ERROR READING MFD
		X CRR
		X GSTS
		X CONTIN
		JRST DDT
		JRST .+1]
	MOVE D,USRNAM
	MOVE Q,MFD+MDNAMP
LISTF1:	CAIL Q,2000
	 JRST [	TYPE USER NOT FOUND - 
		MOVE A,D
		X T6B
		JRST CRDDT]
	CAME D,MFD(Q)
	 JRST [	ADDI Q,LMNBLK
		JRST LISTF1]
	SUBI Q,2000
	IDIVI Q,LMNBLK
	HRRZ J,Q
	ADD J,NUDS
	MOVEM J,DBLK
	MOVE I,FUNIT		;USE FIRST ACTIVE UNIT
	MOVEI A,OUSRD
	X READ
	JUMPL T,[TYPE ERROR READING USER DIRECTORY
		X CRR
		X GSTS
		X CONTIN
		JRST CRDDT
		JRST .+1]
	X USEE0
	JRST CRDDT

CONTIN:	TYPE CONTINUE?
	X TYI
	X CRR
	CAIN A,"Y
	 AOS (P)
	POPJ P,

LISTF4:	TYPE NO ACTIVE UNIT TO GET DIR FROM
	JRST CRDDT

UFDPR:	SETZM SALVRT		;NO AUTO SYS STARTUP
	SKIPN NOLPT
	 JRST [	TYPE Errors in directory 
		MOVE A,OUSRD+UDNAME
		X T6B
		X CRR
		JRST .+1 ]
USEE0:	MOVE Q,OUSRD+UDNAME
	PUSHJ P,LFORM
	LPR USER DIRECTORY: 
	MOVE A,Q
	X L6B
	MOVEI A,";
	X LTYO
	X LCRR
	MOVEI J,OUSRD
	ADD J,UDNAMP(J)
	CAIG J,OUSRD+2000
	CAIGE J,OUSRD+UDDESC
	 JRST [ LPR UFD NAME AREA POINTER OUT OF RANGE
		JRST USEEF ]
	MOVE T,OUSRD+UDESCP
	IDIVI T,6
	ADDI T,OUSRD+UDDESC
	CAML T,J
	 JRST [	LPR DESCRIPTOR FREE POINTER OVERLAPS NAME AREA
		JRST USEEF ]
	MOVEM J,LAST
	MOVEI Q,OUSRD+2000-LUNBLK
USEE1:	CAMGE Q,LAST			;PER FILE LOOP
	 JRST USEEF
	MOVEM Q,LASTQ
	SKIPN A,UNFN1(Q)
	SKIPE UNFN2(Q)
	 CAIA
	  JRST USEELP
	X LPTFIL
	LDB C,[UNPKN UNRNDM(Q)]
	X FINDPK
	MOVEM C,FUNIT			;KLUDGE KLUDGE (LOOKS AT TUTS)
	LDB A,[UNDSCP UNRNDM(Q)]
	CAML A,OUSRD+UDESCP
	 JRST [	LPR FILE DESCRIPTOR POINTER POINTS OUTSIDE DESCRIPTOR AREA
		JRST USEELY ]
	IDIVI A,6
	ADDI A,OUSRD+UDDESC
	HLL A,QBTBLI(B)
	TLNE A,400000
	 SUB A,[440000,,1]
	LDB B,A
	X LTAB
	X USBYTE
	LPR (INITIAL ZERO) 
	JUMPN B,[ LPR - IS NOT PRESENT
		  JRST USEELY ]
	X LCRR
USEE2:	MOVE N,A
	MOVEI J,0
	ILDB B,A			;PEEK AT NEXT BYTE
	JUMPE B,[X USBYTE
		 LPR  (FIRST BYTE SHOULD BE NON-ZERO) 
		 JRST USEELY]		;SHOULD BE NON-ZERO
	LDB A,[UNDSCP UNRNDM(Q)]
	X LOPT				;SHOW DESC ADDR BEFORE FIRST DESC BYTE
USEE3:	MOVE TT,UNRNDM(Q)
	TLNE TT,UNLINK
	 JRST USLINK
;FALLS THROUGH
	SETZM ADRSET
USLUP:	ILDB B,N
	X LTAB
	X USBYTE
	JUMPE B,[LPR (STOP)
		 X LCRR
		 JRST USEELP]
	CAIN B,UDWPH
	 JRST [	LPR (WRITE-PLACE-HOLDER)
		X LCRR
		JRST USLUP]
	CAIL B,UDWPH
	 JRST USLOAD
	CAILE B,UDTKMX
	 JRST USSKIP
	LPR (TAKE-N BLOCKS) 
USLP1:	AOS Q
USLP2:	MOVE A,Q
	X LOPT
	X LSPAC
	SKIPGE TT,FUNIT
	 JRST USLP3		;PACK NOT MOUNTED
	MOVE TT,QOTUTO(TT)
	CAMGE Q,QLASTB(TT)
	 SKIPN ADRSET
	  JRST USLPE		;BAD BLOCK
	ILDB TT,J		;TUT ENTRY
	CAMGE Q,NUDS
	 JRST USLPE
	MOVSI D,-LSBTAB
	CAMN Q,SBTAB(D)
	 JRST USLPE
	AOBJN D,.-2
	MOVE A,FUNIT
	MOVE D,MFDBK
	SUB D,NTBL(A)
	CAML Q,MFDBK
	 CAMLE Q,D
	  CAIA
	   JRST USLPE		;OVERLAPS TUT OR MFD

	SKIPL FUNIT		;FILE NOT ON ACTIVE UNIT
	 CAIN TT,1
	  JRST USLP3
	LPR ?? TUT=
	MOVE A,TT
	X LDPT
	LPR ?? 
USLP3:	SOJG B,USLP1
	X LCRR
	JRST USLUP
USLPE:	LPR ?? BAD BLOCK # ?? 
	JRST USLP3

USEELP:	MOVE Q,LASTQ
	SUBI Q,LUNBLK
	JRST USEE1

USLOAD:	SETOM ADRSET
	ANDCMI B,20		;DM FUNNY BITS
	MOVEI J,-UDWPH-1(B)
	MOVEI K,NXLBYT
USLOD1:	ILDB B,N
	X USBYTE
	LSH J,6
	ADD J,B
	SOJG K,USLOD1
	MOVE Q,J
	SKIPGE I,FUNIT
	 TDZA J,J		;NO TUT
	  PUSHJ P,TUTPNO	;GET POINTER TO OLD TUT
	ADD J,[TUTBYT_14,,]	;BACK UP FOR ILDB
	LPR (JUMP 
	MOVE A,Q
	X LOPT
	LPR ) 
	MOVEI B,1
	JRST USLP2

USSKIP:	SUBI B,UDTKMX
	LPR (SKIP 
	MOVE A,B
	X LOPT
	LPR ) 
	IBP J
	AOS Q
	SOJG B,.-2
	MOVEI B,1
	JRST USLP1

USLINK:	X LTAB
	LPR (LINK) 
	X USLINP
	 JRST USLIN3
	MOVEI A,";
	X LTYO
	X USLINP
	 JRST USLIN3
	X LSPAC
	X USLINP
	 ADD N,[060000,,]	;ENDS WITH ZERO, RE-READ THE ZERO BYTE
	X LCRR
	ILDB B,N
	X LTAB
	X USBYTE
	LPR (ZERO) 
	JUMPE B,USLIN4
	LPR  ?? NO END ZERO ??
USLIN4:	X LCRR
	JRST USEELP
	
USLIN3:	LPR  ?? ENDS EARLY ??
	JRST USLIN4

USLINP:	MOVEI B,6
USLIN2:	ILDB A,N
	JUMPE A,CPOPJ		;NON SKIP RETURN IF FOLLOWED BY ZERO
	CAIN A,';
	 JRST POPJ1		;SKIP RETURN IF ENDS NATURALLY
	CAIN A,':		;QUOTE CHAR
	 ILDB A,N
	ADDI A,40
	X LTYO
	SOJG B,USLIN2
	JRST POPJ1		;SKIP RETURN IF ENDS NATURALLY

USBYTE:	PUSH P,A
	PUSH P,B
	LDB A,[30300,,(P)]
	ADDI A,"0
	X LTYO
	LDB A,[300,,(P)]
	ADDI A,"0
	X LTYO
	X LSPAC
	POP P,B
	POP P,A
	POPJ P,

USEELY:	X LCRR
USSELP:	MOVE Q,LASTQ
	SUBI Q,LUNBLK
	JRST USEE1

USEEF:	X LCRR
	X LFORM
	POPJ P,

SUBTTL MAIN SALVAGER - WRITE MFD & TUT

MFDFIN:	MOVEI I,0
MFDFN0:	SKIPE QACT(I)
	 PUSHJ P,TUTCMP
	CAIGE I,NUNITS-1
	 AOJA I,MFDFN0
	SKIPN MFDWRT
	 JRST SHARCK		;MFD DIDN'T HAVE ANY CHANGES
MFDWR0:	SKIPE NOQUES
	 JRST MFDWR1
	TYPE WRITE OUT CHANGES IN MFD?
	X Y.OR.N
	 JRST SHARCK
MFDWR1:	MOVE J,MFDBK
	MOVEI I,NUNITS-1
MFDWR2:	MOVEI A,MFD
	SKIPE T,QACT(I)
	 PUSHJ P,WRITE
	JUMPGE T,MFDWR3
	PUSHJ P,GSTS		;ERROR WRITING MFD
	SKIPN GOGOX
	 JRST MFDWR0
	JRST ERRDDT

MFDWR3:	SOJGE I,MFDWR2
	JRST SHARCK

TUTCMP:	SETZM TUTDFR		;FIRST SEE IF ANY DIFFERENCES
	SETZM TTDFPS
	SETZM NLKBKS'
	SETZM TUTCHG		;MAKE SUMMARY TABLE OF DIFFERENCES
	MOVE Q,[TUTCHG,,TUTCHG+1]
	BLT Q,TUTCHG+<TUTMAX*TUTMAX>-1
	MOVE Q,QTTBLI
	HRR Q,QNTUTO(I)		;NEW B.P.
	ADDI Q,LTIBLK
	MOVE J,Q
	HRR J,QOTUTO(I)		;OLD B.P.
	MOVE TT,QFRSTB(J)	;BLOCK NUMBER
	MOVE B,QLASTB(J)
	SOS B
	MOVEM B,TUTHIB'		;HIGHEST BLOCK #
	ADDI J,LTIBLK
TUTC1:	ILDB B,Q
	ILDB D,J
	CAMN B,D
	 JRST TUTC2
	CAIN D,TUTLK
	 JRST [	MOVE B,D	;IF LOCKED, STAY LOCKED
		DPB B,Q
		AOS NLKBKS	;COUNT BLOCKS LOCKED DUE TO DISK ERRORS
		SKIPN GOGOX
		 PUSHJ P,LCKRPT	;IN CHKR MODE, REPORT LOCKED BLOCKS
		JRST TUTC2 ]
	PUSHJ P,TUTC4
TUTC2:	CAMGE TT,TUTHIB
	 AOJA TT,TUTC1
	SKIPN NOQUES
	 SKIPN A,NLKBKS
	  JRST TUTC3
	X TDPT
	UNTMES  LOCKED BLOCKS ON UNIT #
	HRRZ A,I
	X DPT
	X CRR
TUTC3:	SKIPN TUTDFR
	 POPJ P,		;NO DIFFERENCES THIS TUT
	JRST TUTCM0		;DIFFERENCES, GO HANDLE

TUTC4:	IMULI B,TUTMAX
	ADD B,D
	MOVE T,QOTUTO(I)	;DON'T LIST TUT CHANGES IN SWAPPING AREA
	CAML TT,NUDS
	CAML TT,QSWAPA(T)
	 AOS TUTCHG(B)
	AOS TUTDFR
	POPJ P,

TUTCM0:	SKIPE NOQUES		;HERE WHEN TUT HAS DIFFERENCES
	 JRST TUTCM3		;IF NO QUESTIONS, JUST WRITE
	MOVEI A,TUTMAX*TUTMAX-1	;SEE IF ANY TUT DIFFERENCES NOT IN SWAPPING AREA
	SKIPN TUTCHG(A)
	 SOJGE A,.-1
	JUMPL A,TUTCM4		;NONE, GO ASK IF SHOULD WRITE
	SETZM LINPOS		;OTHERWISE, SUMMARIZE TUT DIFFERENCES
	TYPE TUT #
	HRRZ A,I
	X DPT
	MOVEI B,TUTMAX-1
TUTSM1:	MOVEI D,TUTMAX-1
TUTSM2:	MOVE A,B
	IMULI A,TUTMAX	
	ADD A,D
	SKIPN A,TUTCHG(A)
	 JRST TUTSM3
	X TSPAC
	X TDPT
	X TSPAC
	MOVE A,B
	X DPT
	TYPE _
	MOVE A,D
	X DPT
	MOVE A,LINPOS
	CAIGE A,60.
	 JRST TUTSM3
	X CRR
	SETZM LINPOS
TUTSM3:	SOJGE D,TUTSM2
	SOJGE B,TUTSM1
	TYPE , PRINT?
	X Y.OR.N
	 JRST TUTCM4

;HERE TO PRINT OUT THE TUT

	SETZM TUTDFR
	MOVE Q,QTTBLI
	HRR Q,QNTUTO(I)		;NEW B.P.
	ADDI Q,LTIBLK
	MOVE J,Q
	HRR J,QOTUTO(I)		;OLD B.P.
	MOVE TT,QFRSTB(J)	;BLOCK NUMBER
	MOVE B,QLASTB(J)
	SOS B
	MOVEM B,TUTHIB'		;HIGHEST BLOCK #
	ADDI J,LTIBLK
TUTCM1:	ILDB B,Q
	ILDB D,J
	CAME B,D
	 JRST TUTDF1
TUTCM2:	CAMGE TT,TUTHIB
	 AOJA TT,TUTCM1

	SKIPE TTDFPS
	 X LCRR
	X LFORM		;SOMETHING PRINTED, ADVANCE LPT PAPER
TUTCM4:	TYPE TUT #
	HRRZ A,I
	X DPT
	TYPE  NEEDS UPDATING - WRITE?
	X Y.OR.N
	 POPJ P,
TUTCM3:
	MOVE A,QNTUTO(I)
	PUSHJ P,WRTUT
	JUMPGE T,CPOPJ
	PUSHJ P,GSTS		;ERROR WRITING TUT
	SKIPN GOGOX
	 JRST TUTCM4
	JRST ERRDDT

TUTMAX=1_TUTBYT

TUTCHG:	BLOCK TUTMAX*TUTMAX

TUTDF1:	MOVE T,QOTUTO(I)
	CAML TT,NUDS
	CAML TT,QSWAPA(T)
	 CAIA
	  JRST TUTCM2		;IN SWAPPING AREA, IGNORE
	PUSHJ P,NEWOLD
	PUSH P,[TUTCM2]
	AOSL TTDFPS
	 JRST TUTDF7		;NO MORE ROOM ON LINE
	MOVEI A,40		;PRINT MULTIPLE FROBS PER LINE
	PUSHJ P,LPTR		;SO THE LINE PRINTER WILL GO FASTER
	JRST LPTR

NEWOLD:	SKIPN TUTDFR
	 PUSHJ P,TUTTYP
	MOVE A,TT
	PUSHJ P,LOPT
	PUSHJ P,LSPAC
	MOVE A,B
	PUSHJ P,LOPT
	MOVEI A,"_
	PUSHJ P,LPTR
	MOVE A,D
	JRST LOPT

TUTTYP:	SETOM TUTDFR
	PUSHJ P,LCRR
	LPR TUT DIFFERENCES FOR DRIVE #
	HRRZ A,I
	PUSHJ P,LOPT
TUTDF7:	MOVNI A,5	;START NEW LINE, ROOM FOR 5 BLOCKS IF TTY
	SKIPN NOLPT
	 MOVNI A,9	;OR 9 IF LPT
	MOVEM A,TTDFPS
	JRST LCRR

LCKRPT:	TYPE LOCKED BLOCK 
	HRRZ A,I
	X TDPT
	MOVEI A,"-
	X TYO
	MOVE A,TT
	X TOPT
	X CRR
	POPJ P,

SUBTTL TRACK DOWN SHARED BLOCKS

SHARCK:	SKIPN SHARED
	 JRST CRDDT	;NO SHARED TRACKS, WE ARE DONE
	TYPE SHARED BLOCKS
	PUSHJ P,LCRR
	LPR LOOKING FOR SHARED BLOCKS
	PUSHJ P,LCRR
	MOVE I,MDSK
	MOVEI A,MFD
	MOVE J,MFDBK
	PUSHJ P,READ
	JUMPL T,ACTUE3
	MOVE Q,MFD+MDNAMP
	ADDI Q,MFD
SMFDLP:	CAIL Q,MFD+2000
	 JRST SHRCKF		;DONE
	SKIPN A,MNUNAM(Q)
	 JRST SMFDL1
	PUSHJ P,SUSRLP
SMFDL1:	ADDI Q,LMNBLK
	JRST SMFDLP

SHRCKF:	SKIPN GOGOX
	 JRST CRDDT
	JRST ERRDDT

SUSRLP:	HRREI J,-MFD-2000(Q)	;CONVERT MFD INDEX TO BLOCK NUMBER
	ASH J,-1
	ADD J,NUDS
	MOVEM A,USRNAM
	PUSH P,Q
	MOVE I,UDSK
	PUSH P,UDSK
SUSRL1:	MOVEI A,OUSRD
	PUSHJ P,READ
	JUMPL T,SUSRE2
	MOVEI Q,2000-LUNBLK+OUSRD
	MOVEI J,OUSRD
	ADD J,UDNAMP(J)
	PUSH P,J
SDIRL1:	CAMGE Q,J
	 JRST SUSRFN
	MOVEM Q,LASTQ
	SKIPE A,UNFN1(Q)
	 JRST .+3
	  SKIPN UNFN2(Q)
	   JRST SDIRLP
	LDB C,[UNPKN UNRNDM(Q)]
	LDB A,[UNDSCP UNRNDM(Q)]
	IDIVI A,6
	ADDI A,OUSRD+UDDESC
	HLL A,QBTBLI(B)
	TLNE A,400000
	 SUB A,[440000,,1]
SDIRL2:	MOVE N,A
	MOVEI J,0
	ILDB B,A
SDIRL3:	MOVE TT,UNRNDM(Q)
	TLNE TT,UNLINK
	 JRST SDIRLP
	PUSHJ P,FINDPK
	SKIPL C
	 SKIPN QACT(C)
	  JRST SDIRLP
	CAIG B,UDWPH		; A LOAD FIRST THING
	 JRST SDIRLP

STRLUP:	ILDB B,N
	JUMPE B,SDIRLP
	CAIN B,UDWPH
	 JRST STRLUP
	CAIL B,UDWPH
	 JRST SLOAD
	CAILE B,UDTKMX
	 JRST SSKIPF
	JRST STLUP

STLUP:	AOS Q
STLUP1:	ILDB D,J
	CAIE D,1
	 PUSHJ P,SPNT
	SOJG B,STLUP
	JRST STRLUP

SLOAD:	ANDCMI B,20		;DM FUNNY BIT
	MOVEI J,-UDWPH-1(B)
	MOVEI K,NXLBYT
SLOAD1:	ILDB B,N
	LSH J,6
	ADD J,B
	SOJG K,SLOAD1
	MOVE Q,J
	MOVE I,C
	PUSHJ P,TUTPNN		;GET PNTR TO TUT
	ADD J,[TUTBYT_14,,]	;COMPENSATE FOR ILDB
	MOVEI B,1
	JRST STLUP1

SSKIPF:	SUBI B,UDTKMX
	IBP J
	AOS Q
	SOJG B,.-2
	MOVEI B,1
	JRST STLUP

SPNT:	MOVE A,USRNAM
	PUSHJ P,L6B
	MOVEI A,";
	PUSHJ P,LTYO
	EXCH Q,LASTQ
	MOVE A,UNFN1(Q)
	PUSHJ P,L6B
	PUSHJ P,LSPAC
	MOVE A,UNFN2(Q)
	PUSHJ P,L6B
	PUSHJ P,LSPAC
	HRRZ A,C
	PUSHJ P,LDPT
	MOVEI A,"-
	PUSHJ P,LTYO
	MOVE A,LASTQ
	PUSHJ P,LOPT
	LPR , TUT= 
	MOVE A,D
	X LDPT
	PUSHJ P,LCRR
	EXCH Q,LASTQ
	POPJ P,

SUSRE2:	TYPE USER DIRECTORY PARITY ERROR
	PUSHJ P,TSPAC
	TYPE BLOCK #
	MOVEM J,DBLK
	MOVE A,J
	PUSHJ P,DPT
	UNTMES UNIT #
	MOVE A,I
	PUSHJ P,DPT
	PUSHJ P,CRR
	PUSHJ P,GSTS
	SKIPE GOGOX
	 JRST ERRDDT
	TYPE TRY NEXT DRIVE?
	X Y.OR.N
	 JRST ERRDDT
	MOVE I,UDSK
SUSR2B:	AOS I
	CAIL I,NUNITS
	 SUBI I,NUNITS
	SKIPN QACT(I)
	 JRST SUSR2B
	MOVEM I,UDSK
	MOVE J,DBLK
	JRST SUSRL1

SUSRFN:	POP P,J
	POP P,UDSK
	POP P,Q
	POPJ P,

SDIRLP:	MOVE Q,LASTQ
	SUBI Q,LUNBLK
	MOVE J,(P)
	JRST SDIRL1

POPBAJ:	POP P,B
POPAJ:	POP P,A
	POPJ P,

SUBTTL INITIALIZATION

INIT:	0
	MOVEI P,PDL
NTS,[ KA,[
	CONO 675550		;RESET APR
	CONO PI,710000		;RESET PI
	MOVE TT,[JSR UUOHLT]	;HALT ON UUO
	SKIPN 41
	 MOVEM TT,41
	MOVEI A,SA		;MAKE SURE ALL NECESSARY MEMORY IS PRESENT
INIT0:	MOVE B,(A)
	CONSZ 10000
	 JRST [	TYPE NXM IN SALV MEM
		JRST ERRDDT ]
	ADDI A,2000
	CAIGE A,THEEND
	 JRST INIT0
];KA
KL,[
	SETZM DTEOPR		;BTB IF QUIT OUT AND RESTART
	CONO APR,267760		;I/O RESET, CLEAR + DISABLE ALL FLAGS
	CONO PI,010000		;CLEAR P.I. SYSTEM
	CONSZ PAG,400000
	 JRST .+4		;JUMP IF CACHE LOOK ENABLE
	  SWPIA			;IF CACHE OFF, INVALIDATE IT BEFORE TURNING ON
	  CONSZ APR,200000
	   JRST .-1
	MOVEI TT,SALVPF		;SET TO HALT ON PAGE FAIL (E.G. PARITY ERROR)
	MOVEM TT,PFNPC
	CONO PAG,600000+EPT/1000 ;SET UP EPT, ENABLE CACHE, DISABLE PAGING AND TRAPS
	DATAO PAG,[100000,,400000+EPT/1000]	;UPT=EPT
	MOVEI TT,UUOHLT
	SKIPN EPT+430		;HALT ON KERNEL UUO
	 MOVEM TT,EPT+430
	MOVEI A,SA		;MAKE SURE ALL NECESSARY MEMORY IS PRESENT
INIT0:	MOVE B,(A)
	CONSZ 2000
	 JRST [	TYPE NXM IN SALV MEM
		JRST ERRDDT ]
	ADDI A,1000
	CAIGE A,THEEND
	 JRST INIT0
RH,	CONI DSK,TT
RH,	TLNN TT,(%HID22)
RH,	 JRST [	TYPE DF10 IN KA MODE??
RH,		JRST ERRDDT ]
IFN T300P,[			;TURN ON DL10 TO ACCESS T-300
	CONO DLC,400000	;MR CLR
	CONO DLB,1	;TURN OFF EXCESS LIGHTS
	CONO DLB,2	;..
	CONO DLB,3	;..
	CONO DLB,DL10AR	;64 WORDS FOR PDP11 #0 AT DL10AR
	DATAO DLC,[200001,,]	;KA INTERRUPT MODE
	CONO DLC,100020	;ENB PDP11 PORT #0 NO INTERRUPTS
];T300P
];KL
DC,	SETZM ENCS
RH,	SETZM MARKF
RP,[	DATAI DPC,A
	TLNN A,NOWRIH
	 JRST [	TYPE [WRITE HEADERS ENABLED]
		X CRR
		JRST .+1 ]
];RP
	SETOM DRIVE		;ALL DRIVES ASSUMED TO BE ON-LINE
	MOVE A,[DRIVE,,DRIVE+1]
	BLT A,DRIVE+NDRIVE-1
	MOVEI A,SLVIOWD		;SET UP CHANNEL PROGRAM AREA
	MOVEM A,SLVICWA
	SETZM SLVIOWD+1
	SETZM SLVICWA+1
];NTS
	SETZM GOGOX
	SETZM NOQUES
	MOVEI A,NUNITS-1
	SETOM QPKN(A)		;TUT NOT IN YET
	SOJGE A,.-1
TS,[
	.OPEN TYIC,[SIXBIT /  $TTY/]
	 .VALUE
	.OPEN TYOC,[SIXBIT /  !TTY/]
	 .VALUE
	.CORE <THEEND-1>_-10.+1
	 .VALUE
	MOVE A,[SQUOZE 0,NQS]
	.EVAL A,
	 .VALUE
	MOVEM A,NQS
	MOVE A,[SQUOZE 0,QACT]
	.EVAL A,
	 .VALUE
	MOVEM A,SQACT
	MOVE A,[SQUOZE 0,NUDSL]
	.EVAL A,
	 .VALUE
	MOVEM A,NUDS
	MOVE A,[SQUOZE 0,MFDBLK]
	.EVAL A,
	 .VALUE
	MOVEM A,MFDBK
	MOVE B,[SQUOZE 0,NTUTBL]
	.EVAL B,
	 .VALUE
	MOVEI C,NUNITS-1
	MOVEM B,NTBL(C)
	SOJGE C,.-1
	CAILE B,MXTUTB
	 .VALUE		;NOT ASSEMBLED FOR BIG ENOUGH TUTS
	MOVE B,[SQUOZE 0,T300P]	;NEED KLUDGES FOR 2 SIZES OF TUT
	.EVAL B,
	 MOVEI B,0
	JUMPE B,INI03
	MOVE C,[SQUOZE 0,NTUTB1]
	.EVAL C,
	 .VALUE
	CAILE C,MXTUTB
	 .VALUE			;TOO BIG
	MOVEM C,NTBL(B)
	CAIGE B,NUNITS-1
	 AOJA B,.-2
INI03:	MOVE A,[SQUOZE 0,NBLKS]
	.EVAL A,
	 .VALUE
	MOVEM A,SNBLKS
	SUBI A,1
	MOVEM A,SNBLKS-1
];TS

	;BRING UP THE LPT

	SETOM NOLPT		;ASSUME THE WORST
	SKIPE LPBUST
	 JRST LPTDWN
	SETOM LPFRST'		;FLAG LPT NOT USED YET

TS,[	TYPE WANT LPT?
	PUSHJ P,TYI
	X CRR
	SETOM LPBUST		;ASK ONLY ONCE
	CAIN A,"Y
	 .OPEN LPTC,[.UAO,,'LPT]
	  JRST LPTDWN
	SETZM NOLPT
	SETZM LPBUST
];TS
;DROPS THROUGH
;DROPS IN
NTS,[
IFN OLPTP,[		;BRING UP AI-KA LPT
LPTUP3:	CONO LPT,10
	DATAO LPT,[440]
	MOVEI A,200000
LPTUP1:	SOJLE A,LPTUP2
	CONSZ LPT,10
	 JRST LPTUP1
	SETZM NOLPT
	JRST LPTDWN
];IFN OLPTP

IFN NLPTP,[			;BRING UP ML LPT
LPTUP3:	SETOM LPTBFC
	MOVE A,[<.BYTE 7 ? 15 ? 15 ? 15 ? 15 ? 15>]
	MOVEM A,LPTBUF
	CONO NLPT,200
	CONO NLPT,1000		;IMAGE MODE
	DATAO NLPT,[23*2]	;MOTOR ON

	MOVEI A,200000		;1 SECOND
LPTUP1:	SOJLE A,LPTUP2
	CONSO NLPT,100		;IS IT ON?
	 JRST LPTUP1
	SETZM NOLPT		;WELL, YES
	CONO NLPT,200
	CONO NLPT,100		;SET OUTPUT DONE
	JRST LPTDWN		;ITS UP
];IFN NLPTP

IFN TTLPTP,[	;BRING UP LPT ATTACHED VIA MTY
LPTUP3:	MOVEI A,200000
LPTUP1:	SOJLE A,LPTUP2
	CONI MTY,B
	TRNN B,40		;ANY INPUT?
	 JRST LPTUP1
	LDB B,[140500,,B]
	DATAI MTY,C
	CAIE B,TTLPTP&77
	 JRST LPTUP1		;NOT FROM LPT

	SETZM NOLPT		;IS FROM LPT -> WIN
	MOVEI B,TTLPTP_14	;LINE NUMBER IN RIGHT PLACE
	CONO MTY,10(B)		;SET OUTPUT DONE
	JRST LPTDWN
];IFN TTLPTP

IFN OLPTP+NLPTP+TTLPTP,[
		;ROUTINE TO ASK IF UP
LPTUP2:	TYPE LPT DOWN (Y OR N)
IFN OLPTP, TYPE  [MAYBE NEEDS RESET BUTTON PUSHED] 
	PUSHJ P,TYI
	X CRR
	CAIN A,"Y
	 JRST LPTUP4
	CAIN A,"N
	 JRST LPTUP3	;"N", CHECK IT AGAIN
	JRST LPTUP2

LPTUP4:	SETOM LPBUST
];IFN OLPTP+NLPTP+TTLPTP
];NTS

LPTDWN:	JRST @INIT

NTS,[
UUOHLT:
KA,	0
	JRST 4,.	;HERE IF UUO IN STAND-ALONE MODE (ELSE HALT IN ITS)
];NTS

SUBTTL LPT & TTY I/O

LDPT:	PUSH P,A
	PUSH P,B
	JUMPGE A,LDPT0
	MOVEI A,"-
	PUSHJ P,LTYO
	MOVN A,-1(P)
LDPT0:	PUSHJ P,LDPT1
	JRST POPBAJ

LDPT1:	IDIVI A,10.
	HRLM B,(P)
	SKIPE A
	 PUSHJ P,LDPT1
	JRST LDPT2

LOPT:	PUSH P,A
	PUSH P,B
	PUSHJ P,LOPT1
	JRST POPBAJ

LOPT1:	LSHC A,-35.	;IN CASE NEGATIVE
	LSH B,-1
	DIVI A,8
	HRLM B,(P)
	SKIPE A
	 PUSHJ P,LOPT1
LDPT2:	HLRZ A,(P)
	ADDI A,"0
;DROPS IN
LTYO:
LPTR:
LPTR1:	SKIPE NOLPT
	 JRST TYLPT		;TYPE ON TTY INSTEAD

	PUSH P,A
	AOSE LPFRST
	 JRST LPTR2
	  TYPE (INFO ON LPT)
	  X CRR
LPTR2:

IFN OLPTP,[
OLP1:	CAIN A,12		;SUPPRESS LF, MAKE CR=CR-LF
	 JRST POPAJ
	CAIN A,15
	 JRST [	CONO LPT,10
		MOVEI A,440
		JRST .+1]
	CAIN A,14
	 MOVEI A,441
	CAIN A,33
	 MOVEI A,"$
	CAIL A,"a
	CAILE A,"z
	 CAIA
	  SUBI A,40		;LOWER CASE -> UPPER CASE
	SUBI A,40
	PUSH P,B
	HRLZI B,2		;3 SECOND TIMEOUT
	CONSZ LPT,10
	 SOJG B,.-1
	JUMPLE B,OLP2
OLP3:	DATAO LPT,A
	JRST POPBAJ

OLP2:	X CRR
	TYPE HIT RESET BUTTON ON LPT
	X CRR
	HRLZI B,15		;20 SECOND TIMEOUT
	CONSZ LPT,10
	 SOJG B,.-1
	JUMPLE B,OLP2
	JRST OLP3
];IFN OLPTP

TS,[	.IOT LPTC,A
	JRST POPAJ
];TS

IFN NLPTP,[		;SEND CHARACTER TO NLPT
	PUSH P,B
	SOSLE LPTBFC	;MORE TO GO
	 JRST LPTR0	;YES
LPTR01:	MOVEI B,5	;NO, NEW WORD
	MOVEM B,LPTBFC
	MOVE B,[440700,,LPTBUF]
	MOVEM B,LPTBFP
	MOVEI B,-1	;TIMEOUT FOR DEAD LPT
	CONSO NLPT,100
	 SOJG B,.-1
	DATAO NLPT,LPTBUF

LPTR0:	IDPB A,LPTBFP	;BUFFER 5 AT A TIME
	CAIL A,12
	CAILE A,14	;LF OR FF, FORCE BUFFER NOW
	 JRST POPBAJ
	MOVEI A,15
LPTR00:	SOSG LPTBFC
	 JRST LPTR01
	IDPB A,LPTBFP
	JRST LPTR00

		;NLPT BUFFERING CRUFT
LPTBUF:	-1	;5 CHAR LPT BUFFER
LPTBFC:	5	;COUNT OF CHARS LEFT IN BUF
LPTBFP:	@.	;BYTE POINTER INTO LPT BUFFER

LPTFIN:	SKIPL LPFRST		;DO NOTHING IF NEVER OUTPUT TO LPT
	SKIPGE NOLPT		;WAS LPT INIT'ED?
	 POPJ P,		;NO, DON'T HANG
	MOVE A, [<.BYTE 7 ? 15 ? 14 ? 15 ? 15 ? 15>]
	MOVEI B, 15
LPTFN0:	SOSG LPTBFC
	 JRST LPTFN1
	IDPB B, LPTBFP
	JRST LPTFN0

LPTFN1:	CONSO NLPT,100		;WAIT FOR THAT TO HAPPEN
	 JRST .-1
	DATAO NLPT, LPTBUF
	CONSO NLPT,100		;WAIT FOR THAT TO HAPPEN
	 JRST .-1
	DATAO NLPT, A
	POPJ P,
];IFN NLPTP

IFN TTLPTP,[
;	call with ascii char in A
;	saves and restores all AC's

	ANDI	A,177	;MASK TO 7 BIT ASCII
	CAIGE	A,40	;SKIP IF NOT CTL CHAR
	CAIN	A,14	;SKIP IF NOT FF
	 JRST	LPTOP	;PRINT LITERALLY FF, GRAPHICS
	CAIN	A,15	;SKIP IF NOT CR
	 JRST	LPCR	;JUMP TO CR ROUT
	CAIN	A,12	;SKIP IF NOT LF
	 JRST	LPLF	;JUMP TO LF ROUT
	CAIN	A,11	;SKIP IF NOT TAB
	 JRST	LPTAB	;JUMP TO TAB ROUT
	MOVEI	A,"^	;HERE FOR RANDOM CTL CHAR
	PUSHJ	P,LPTO	;PUT OUT ^FOO
	MOVE	A,(P)	;RETREIVE CHAR
	ADDI	A,100	;MAKE IT A 'LETTER'
LPTOP:	PUSHJ	P,LPTO
	JRST	POPAJ

LPCR:	SKIPE	LPTPOS	;SKIP IF STILL AT LEFT MARGIN
	PUSHJ	P,LPTO	;ELSE PUT OUT CR
	SETZM	LPTPOS	;MARK 'AT LEFT MARGIN'
	SETOM	LPCRLF	;MARK LF AFTER CR
	MOVEI	A,12	;LF
	JRST	LPTOP	;OUTPUT IT

LPLF:	AOSE	LPCRLF	;SKIP IF THIS LF AFTER CR
	 JRST	LPTOP	;ELSE PUT IT OUT
	JRST	POPAJ

LPTAB:	MOVEI	A,40	;SPACES FOR TAB
	PUSHJ	P,LPTO
	MOVE	A,LPTPOS	;CHECK POS
	TRNE	A,7	;SKIP IF POS = 0 MOD 8
	 JRST	LPTAB	;ELSE PUT ANOTHER SPACE
	JRST	POPAJ

LPTO:	CAIL	A,40	;SKIP FOR CTL CHAR NOT COUNTED
	 AOS	LPTPOS	;COUNT CHAR
	PUSH	P,A
	PUSH	P,B
	MOVEI	A,-1	;TIMER FOR FLAG
LPWAIT:	SOJLE	A,LPTOUT
	CONI	MTY,B	;GET STATUS
	TRNE	B,40	;SKIP IF NO INPUT FLAG
	 JRST	FLSINP	;ELSE JUMP TO FLUSH INPUT
	TRNN	B,10	;SKIP IF OUTPUT FLAG
	 JRST	LPWAIT	;ELSE LOOP
	LDB	B,[140500,,B]	;GET SUBDEV #
	CAIE	B,TTLPTP&77	;SKIP IF THIS IS LPT #
	 JRST	FLSOUT	;ELSE FLUSH
LPTOUT:	MOVEI	B,TTLPTP_14 ;GET LPT NO IN SUBDEV POSITION
	CONO	MTY,(B)	;SELECT SUBDEV
	POP	P,B	;RESTORE AC
	MOVE	A,(P)	;GET CHAR
	LSH	A,35	;PUT IN FUNNY POSITION
	DATAO	MTY,A	;PUT OUT 1 CHAR
	JRST	POPAJ

FLSINP:	DATAI	MTY,B	;READ INPUT
	JRST	LPWAIT	;AND IGNORE

FLSOUT:	LSH	B,14	;SHIFT TO SELECT
	CONO	MTY,200(B)	;RESET FLAG, IT'S NOT LPT
	JRST	LPWAIT

LPTPOS:	0	;PRINT POSITION FROM LEFT MARGIN
LPCRLF:	0	;# CHARS AFTER LAST CR, -1 IF TO IGNORE LF
];IFN TTLPTP

TYLPT:	CAIN A,14
	 JRST CRR		;NO FF ON TTY
	JRST TYO

SIXTYP:
T6B:	PUSH P,B		;OUTPUT SIXBIT IN A
	PUSH P,A
	LSHC A,-36.
T6B1:	LSHC A,6
	ADDI A,40
	PUSHJ P,TYO
	MOVEI A,0
	JUMPN B,T6B1
	POP P,A
POPBJ:	POP P,B
	POPJ P,

SIXLPT:
L6B:	PUSH P,B		;OUTPUT SIXBIT IN A
	PUSH P,A
	MOVE B,[440600,,(P)]	;ALWAYS OUTPUTS SIX COLUMNS
L6B1:	ILDB A,B		;CAN YOU GUESS WHY?  WIN A KEWPIE DOLL!
	ADDI A,40
	PUSHJ P,LPTR
	TLNE B,770000
	 JRST L6B1
	POP P,A
	POP P,B
	POPJ P,

SLPT:	PUSH P,B
	MOVE B,A
SL1:	ILDB A,B
	JUMPE A,POPBJ
	PUSHJ P,LPTR
	JRST SL1

DPT:
TOPT:	PUSH P,A
	PUSH P,B
	MOVEI B,8
	MOVEM B,ORADIX
	PUSHJ P,TDPT1
	JRST POPBAJ

TDPT:	PUSH P,A
	PUSH P,B
	MOVEI B,10.
	MOVEM B,ORADIX'
	PUSHJ P,TDPT1
	JRST POPBAJ

TDPT1:	LSHC A,-35.		;IN CASE NEGATIVE
	LSH B,-1
	DIV A,ORADIX
	HRLM B,(P)
	SKIPE A
	 PUSHJ P,TDPT1
	HLRZ A,(P)
	ADDI A,"0
	JRST TYO

LTAB:
IFN OLPTP,[
	PUSHJ P,LSPAC	;OLD LPT LACKS TABS
	PUSHJ P,LSPAC
	PUSHJ P,LSPAC
	JRST LSPAC
];IFN OLPTP

.ELSE [	PUSH P,A
	MOVEI A,11		;NLPT HAS HARDWARE TABS
	JRST L1
];ELSE

LCRR:	PUSH P,A
	MOVEI A,15
	PUSHJ P,LPTR
	MOVEI A,12
	PUSHJ P,LPTR
	JRST POPAJ

LSPAC:	PUSH P,A
	MOVEI A,40
L1:	PUSHJ P,LPTR
	POP P,A
	POPJ P,

LFORM:	PUSH P,A
	MOVEI A,14
	PUSHJ P,LPTR
	JRST POPAJ

LOUTST:	0
	PUSH P,A
	PUSH P,B
	HRRZ B,@LOUTST
	HRLI B,440700
LOUT2:	ILDB A,B
	JUMPE A,LOUT1
	X LPTR
	JRST LOUT2

LOUT1:	POP P,B
	POP P,A
	AOS LOUTST
	JRST 2,@LOUTST

TOUTST:	0
	PUSH P,A
	PUSH P,B
	HRRZ B,@TOUTST
	PUSHJ P,OUTSTR
	AOS TOUTST
	POP P,B
	POP P,A
	JRST 2,@TOUTST

OUTSTR:	HRLI B,440700
OUTST1:	ILDB A,B
	JUMPE A,CPOPJ
	PUSHJ P,TYO
	JRST OUTST1

ERRDDT:	PUSHJ P,CRR
	TYPE *** ERROR *** SYSTEM MAY NOT BE BROUGHT BACK UP
CRDDTE:	NTS, SETZM SALVRT		;CAN'T RETURN TO SYSTEM
CRDDT:	PUSHJ P,CRR

DDT:
NTS,[
IFN NLPTP, PUSHJ P,LPTFIN		;UNBUFFER LINE PRINTER
	SKIPE SALVRT
	 JRST @SALVRT
	TYPE DDT
	SKIPN MEMSIZ-4000
	 JRST 4,.			;NO DDT LOADED?
	JRST MEMSIZ-4000
];NTS
TS,[	.VALUE [ASCIZ\:DDT
\]
	JRST DDT
];TS

CRR:	PUSH P,A
	PUSHJ P,CRR1
	SETZM LINPOS'
	JRST POPAJ

CRR1:	MOVEI A,15
	PUSHJ P,TYO
	MOVEI A,12
	JRST TYO

TSPAC:	PUSH P,A
	MOVEI A,40
	X TYO
	JRST POPAJ

TYO:
TS,	.IOT TYOC,A
NTS,[
KA,[
	CONSZ TTY,20
	 JRST .-1
	DATAO TTY,A
	SKIPN PUNCH
	 JRST TYO0
	CONSZ PTP,20		;WAIT FOR NOT BUSY
	 JRST .-1
	DATAO PTP,A
TYO0:
];KA
KL,[
	PUSH P,A
	ANDI A,177
	PUSHJ P,DTEXIO
	POP P,A
];KL
];NTS
	AOS LINPOS
	POPJ P,

KL,[	;DTE20 COMMUNICATION ROUTINE ... COPIED FROM DEC "SUBRTN" PROGRAM

DTEXIO:	SETZM DTEFLG
	MOVEM A,DTECMD
	SETZM DTEF11
	CONO DTE,%DBL11
	SKIPN DTEFLG
	 JRST .-1
	SETZM DTEFLG
	MOVE A,DTEF11
	POPJ P,
];KL

NTYI:	PUSHJ P,TYI		;INPUT DIGIT, SKIP IF WIN
	CAIL A,"0
	CAILE A,"9
	 POPJ P,
	SUBI A,"0
POPJ1:	AOS (P)
	POPJ P,

SIXIN:	PUSH P,C
SIXI1:	MOVE C,[440600,,B]
	SETZ B,
SIXIL:	X TYI
	CAIL A,140
	 JRST [	TYPE XXX   
		JRST SIXI1]
	CAIG A,40
	 JRST SIXIX
	CAIN A,";
	 JRST SIXIL
	SUBI A,40
	TLNE C,770000
	 IDPB A,C
	JRST SIXIL

SIXIX:	POP P,C
	POPJ P,

TYI:				;INPUT CHAR INTO A
TS,	.IOT TYIC,A
NTS,[
KA,[
	CONSO TTY,40
	 JRST .-1
	DATAI TTY,A
];KA
KL,[
	MOVEI A,3400		;"DDT MODE" INPUT
	PUSHJ P,DTEXIO
	JUMPE A,.-2
];KL
];NTS
	ANDI A,177
	CAIL A,"a		;MIGHT NOT BE KSR-35
	CAILE A,"z
	 CAIA
	  SUBI A,40
	CAIN A,^Z
	 JRST CRDDTE
	JRST TYO

;RETURN TO DDT IF CHARACTER TYPED
TYIPSE:	PUSHJ P,TYIP
	 POPJ P,
	PUSHJ P,TYI
	JRST DDT

;SKIP IF INPUT AVAILABLE
TYIP:	PUSH P,A
TS,[	.LISTEN A,
	SKIPE A
];TS
NTS,[
KA,	CONSZ TTY,40
KL,[	MOVEI A,3400
	PUSHJ P,DTEXIO
	SKIPE A
];KL
];NTS
	 AOS -1(P)
	POP P,A
	POPJ P,

Y.OR.N:	PUSH P,A		;YES OR NO, SKIP IF YES
YORN1:	X TYI
	X CRR
	CAIE A,"Y
	CAIN A,"N
	 JRST YORN2
	TYPE (Y OR N) 
	JRST YORN1		;TELETYPE KEYBOARD LOSSAGE?

YORN2:	CAIN A,"Y
	 AOS -1(P)
	JRST POPAJ

SUBTTL MAG TAPE I/O

NTS,[	MTC==340		;MAG TAPE CHANNEL FOR FUNCTIONS
	MTS==344		;MAG TAPE CHANNEL FOR STOPPING AND STATUS

;SHIFTS FOR FIELDS IN CONO MTC,
	UNITNO==15.
	PARITY==14.
	CDUMP==13.
	FUNC==9.
	DENSTY==6.

	800BPI==2

	MAGCOM=5_<UNITNO>+1_<PARITY>+800BPI_<DENSTY>+1_<CDUMP>

;FUNCTIONS
	NOOP1=0_<FUNC>+MAGCOM	;CLEAR INTERRUPT FLAGS
	NOOP2=10_<FUNC>+MAGCOM	;INTERRUPT WHEN TRANSPORT IDLE
	REWIND=1_<FUNC>+MAGCOM	;REWIND
	REED=2_<FUNC>+MAGCOM	;READ
	SPACR=7_<FUNC>+MAGCOM	;SPACE REVERSE

;FLAGS
	JOBDON==100
	DATREQ==1
	EOFF==10000
	EOTF==4000
;NOTE - TM10B HAS DATA PIA (CONI MTC, 1.1-1.3) STUCK AT 7

REW:	CLEARM EOFCNT
	CLEARM MAGBFP
	CLEARM SHORTL
	CONO MTC,NOOP1	;CLEAR INTERRRUPT FLAGS
	CONO MTC,REWIND	;INITIATE REWIND
	CONSO MTS,JOBDON	;WAIT FOR REWIND TO BEGIN
	 JRST .-1
	CONO MTC,NOOP2	;SET JOB DONE WHEN TRANSPORT IDLE
	CONSO MTS,JOBDON	;WAIT FOR JOB DONE
	 JRST .-1
	SETOM ITAPE
	POPJ P,		;REWIND DONE
ITAPE:	0

MREAD:	MOVEI T,0
	PUSH P,B
MREAD7:	SKIPGE B,MAGBFP
	 JRST MREAD5
	SKIPN EOFLG
	 JRST MREAD1
	SETZM EOFLG
	SETOM EOUF
	JRST POPBJ

MREAD1:	MOVEI B,10.
	MOVEM B,MTRYS
MERR2:	MOVE B,[-2000,,MAGBUF]
	MOVEM B,MAGBFP
	SETZM SLVIOWD
	CONO MTC,NOOP1		;CLEAR FLAGS
	CONSO MTC,7		;IS THIS A TM10B?
	 JRST MREADA		;NO
KA,	MOVE B,[-2000,,MAGBUF-1]	;YES SET UP CHANNEL PROGRAM
KL,	MOVE B,[-2000_4,,MAGBUF-1]
	MOVEM B,SLVIOWD
	SETZM SLVICWA+1
	SETZM SLVIOWD+1
	DATAO MTS,[SLVICWA]
KL,[	SWPUA			;UNLOAD THE CACHE
	PUSH P,A
	MOVE A,[CONSZ APR,200000]
	MOVE B,[JRST A]
	MOVE C,[POPJ P,]
	PUSHJ P,A
	POP P,A
]
MREADA:	CONO MTC,REED
MREAD2:	CONSO MTS,DATREQ+EOFF+JOBDON+EOTF	;WAIT FOR NEXT DATA REQUEST
	 JRST .-1
	MOVEI C,20.
	SOJG C,.
	CONI MTS,C
	TRNE C,EOTF
	 JRST MREOT
	TRNN C,JOBDON
	 JRST MREAD3
	TRNN C,EOFF
	 JRST MREAD6
	AOS EOFCNT
	SETOM EOFLG
	CLEARM SHORTL
	JRST MREAD9

MREAD6:	SETOM SHORTL
MREAD9:	CONSZ MTC,7		;SKIP IF TM10A
	 JRST MREADB
	HLLZS B
	MOVNS B
	ADDM B,MAGBFP
	JRST MREAD4

MREADB:	HRRZ B,SLVICWA+1
	JUMPE B,.-1
	MOVNI B,1-MAGBUF(B)
	SKIPE EOFLG
	 MOVSI B,0		;EOF MARK => NO WORDS READ
	HRLM B,MAGBFP
	JRST MREAD4

MREAD3:	TRNE C,DATREQ
	 CONSZ MTC,7		;SKIP IF TM10A
	  JRST MREAD2		;TM10B OR NO DATA REQUEST
	DATAI MTC,(B)
	SKIPE SHORTL
	 JRST 4,.
	AOBJN B,MREAD2
MREAD4:	CONO MTS,1
	CONSO MTS,JOBDON
	 JRST .-1
	CONSZ MTS,440000	;X HUNG + ILL OP
	 JRST 4,MERR
MREAD8:	CONSO MTS,20600
	 JRST MREAD7
MERR:	SOSG MTRYS
	 JRST MERR1
	SETZM SLVIOWD
KL,[	SWPUO 0
	CONSZ APR,200000
	 JRST .-1
]
	CONO MTC,NOOP1
	CONO MTC,SPACR
	CONSZ MTC,7		;SKIP IF TM10A
	 JRST .+4
	  CONSO MTS,DATREQ
	   JRST .-1
	  DATAO MTC,
	CONO MTS,1
	CONSO MTS,JOBDON
	 JRST .-1
	JRST MERR2

MERR1:	AOS FERRS	;IGNORE ERR
	JRST MREAD7

MREAD5:	HLRE C,B
	CAMG B,A
	 HLRE C,A
	HRLZS B
	HRR B,A
	MOVNS C
	HRLS C
	ADDI C,-1(A)
	BLT B,(C)
	HLRS C
	ADD A,C
	ADDM C,MAGBFP
	ADDI T,(C)
	JUMPGE A,POPBJ
	JRST MREAD7

MREOT:	CONO MTS,1		;STOP TAPE IF STILL MOVING
	CONO MTC,NOOP1
	LPR EOT
	X LCRR
	JRST DDT
];NTS

SUBTTL TYPE CONTROLLER AND DRIVE STATUS
TS,[
GSTS:	POPJ P,
];TS

DC,[
GETSTS:	MOVEI P,PDL
	PUSH P,[DDT]
GSTS:	INSIRP PUSH P,[A B C D T]
	CONI DC0,D
	MOVEI C,DC0STS
	TYPE CONTROLLER STATUS:
	PUSHJ P,TYPSTS
	CONI DC1,D
	MOVEI C,DC1STS
	PUSHJ P,TYPSTS
	CONO DC0,DCCSET+DCDENB
	DATAO DC0,[DJMP GETUNT]
	CONSZ DC0,DSSACT
	JRST .-1
	TYPE CURRENT UNIT=
	LDB A,[DUNFLD GOTUNT]
	DPB A,[DUNFLD STOSTS]
	PUSHJ P,TDPT
	TYPE ,DRIVE STATUS:
	PUSHJ P,CRR
	DATAO DC0,[DJMP STOSTS]
	CONSZ DC0,DSSACT
	JRST .-1
	MOVE D,STATUS
	LSH D,-15.
	MOVEI C,DRVSTS
	PUSHJ P,TYPSTS
	TYPE CYLINDER=
	LDB A,[101100,,STATUS]
	PUSHJ P,TOPT
	PUSHJ P,CRR
	INSIRP POP P,[T D C B A]
	POPJ P,

TYPSTS:	SETOM FIRST'
TYPST1:	SKIPN B,(C)
	JRST CRR
	HLRZ T,B		;FLAGS TO TEST
	TDNN D,T
	AOJA C,TYPST1
	MOVEI A,",
	AOSE FIRST
	PUSHJ P,TYO
	MOVE A,LINPOS
	CAILE A,TCMXH
	PUSHJ P,CRR
	PUSHJ P,OUTSTR
	AOJA C,TYPST1
;DC
DEFINE STS A,B/
A,,[ASCIZ \B\]
TERMIN

DC0STS:	STS 4000,ERROR-FLG
	STS 1000,ATTENTION
	STS 200,RUN
	STS 100,ACTIVE
	0

DC1STS:	STS 4000,INTERNAL-PARITY-ERROR
	STS 2000,RECORD-LENGTH
	STS 1000,READ-COMPARE
	STS 400,OVERRUN
	STS 200,CHECKSUM/DECODER
	STS 100,BARK!!
	STS 40,FILE-UNSAFE/SEEK-INCOMPLETE/END-OF-DISC
	STS 20,OFF-LINE/MULTIPLE-SELECT
	STS 10,RDG-KEY/PROTECT/READONLY
	STS 4,DATAO-WHILE-BUSY
	STS 2,NON-EX-MEM
	STS 1,CORE-PARITY-ERROR
	0

DRVSTS:	STS 4,UNIT-SELECTED
	STS 10,ON-LINE
	STS 20,READY
	STS 40,SEEK-INCOMPLETE
	STS 100,READ-ONLY
	STS 200,UNSAFE
	STS 400,WRITE-CURRENT-SENSED(?)
	0

GETUNT:	DJSR .+1
GOTUNT:	0
	DHLT

STOSTS:	DSDRST+DUNENB STATUS(74)
	DHLT
STATUS:	0
];DC

RP,[
GETSTS:	MOVEI P,PDL
	PUSH P,[DDT]
GSTS:	INSIRP PUSH P,[A B C D T]
	TYPE DISK STATUS:
	CONI DPC,D
	MOVEI C,CNLSTS
	TLNE D,-1
	 PUSHJ P,TYPSTS
	MOVSS D
	MOVEI C,CNISTS
	PUSHJ P,TYPSTS
	DATAI DPC,D
	TLC D,1			;REVERSE SENSE OF WRITE HEADER LOCKOUT SWITCH
	MOVEI C,DTISTS
	PUSHJ P,TYPSTS
	TYPE CURRENT UNIT=
	LDB A,[DUNFLI D]
	PUSHJ P,TDPT
	TYPE , CYLINDER=
	LDB A,[DCYLI D]
	TRNE D,.BM DCYLXI
	 ADDI A,400
	PUSHJ P,TOPT
	TYPE , LAST ADDRESSED CYL=
	MOVE A,RPIOCY
	X TOPT
	TYPE , SURF=
	MOVE A,RPIOHD
	X TOPT
	TYPE , SEC=
	MOVE A,RPIOSC
	X TOPT
	PUSHJ P,CRR
	INSIRP POP P,[T D C B A]
	POPJ P,

TYPSTS:	SETOM FIRST'
TYPST1:	SKIPN B,(C)
	 JRST CRR
	HLLZ T,B		;FLAGS TO TEST
	TDNN D,T
	 AOJA C,TYPST1
	MOVEI A,",
	AOSE FIRST
	 PUSHJ P,TYO
	MOVE A,LINPOS
	CAILE A,TCMXH
	 PUSHJ P,CRR
	PUSHJ P,OUTSTR
	AOJA C,TYPST1

;RP
DEFINE STS A,B/
A,,[ASCIZ \B\]
TERMIN

; CONI STATUS TABLE (RH)

CNISTS:	STS 400000,SEARCH DONE
	STS 200000,END OF CYLINDER
	STS 100000,POWER FAILURE
	STS 040000,SEARCH ERROR
	STS 020000,OVERRUN
	STS 010000,NXM
	STS 002000,DRIVE NOT READY
	STS 001000,WRITE PROTECT
	STS 000400,DATAO WHEN BUSY
	STS 000200,SECTOR ADDRESS ERROR
	STS 000100,SURFACE ADDRESS ERROR
	STS 000020,BUSY
	STS 000010,DONE
	0

; CONI STATUS TABLE (LH)

CNLSTS:	STS 000010,CONTROL WORD PARITY ERROR
	STS 000004,SECTOR PARITY ERROR
	STS 000002,MEMORY WORD PARITY ERROR
	STS 000001,DISK WORD PARITY ERROR
	0

; DATAI STATUS TABLE (LH)

DTISTS:	STS 000100,SEEK INCOMPLETE
	STS 000040,ON CYLINDER
	STS 000020,DISK ON-LINE
	STS 000010,FILE UNSAFE
	STS 000004,NON EXISTENT DRIVE
	STS 000002,DRIVE IS READ-ONLY
	STS 000001,WRITE HEADER LOCKOUT OFF!!
	0
];RP

RH,[
GETSTS:	MOVEI P,PDL
	PUSH P,[DDT]
GSTS:
IFN T300P,[
	SKIPE T3IOP
	 JRST T3STS		;LAST OPERATION WAS REALLY TO T-300
];T300P
	INSIRP PUSH P,[A B C D T I K] 
	TYPE CONTROLLER STATUS:
	CONI DSK,D
	MOVEI C,CNLSTS
	TLNE D,-1
	 PUSHJ P,TYPSTS
	MOVSS D
	MOVEI C,CNISTS
	PUSHJ P,TYPSTS
	TYPE CURRENT REGISTER:
	DATAI DSK,D
	PUSHJ P,TYPRGN
	MOVE A,D
	PUSHJ P,TOPT		;TYPE REG NO, STATUS, AND CONTENTS IN OCTAL
	JUMPL D,GSTS0		;DO FOLLOWING ONLY FOR DRIVE REGS
	 MOVEI A,",
	 PUSHJ P,TYO
	 MOVEI C,DIBSTS
	 PUSHJ P,TYPSTS
	 CAIA			;DON'T GIVE BLANK LINE
GSTS0:	PUSHJ P,CRR
	TYPE CURRENT DRIVE=
	LDB A,[$HCDRV D]
	PUSHJ P,TDPT
	PUSHJ P,CRR
	MOVEI I,NUNITS-1	;CONVERT BACK TO VIRTUAL UNIT
	CAME A,QTRAN(I)		;TO MAKE RHGET HAPPY
	 SOJGE I,.-1
	JUMPL I,GSTS3		;FOO!! ADDRESSING NON EXISTENT DRIVE

	MOVSI K,-LGSTSR		;DISPLAY DRIVE REGS SPEC'ED IN TABLE
GSTS1:	MOVE D,GSTSRT(K)
	PUSHJ P,TYPRGN		;TYPE REG NAME
	HRRZ C,D		;C -> STATUS BIT TABLE
	HLLZ A,D		;A := REG NUMBER
	PUSHJ P,RHGET		;GET CONTENTS OF REG
	 JRST GSTSER		;??
	PUSHJ P,TOPT		;GIVE CONTENTS IN OCTAL
	PUSHJ P,TSPAC
	MOVS D,A		;AND SYMBOLICLY
	PUSHJ P,TYPSTS
	AOBJN K,GSTS1
GSTS3:	INSIRP POP P,[K I T D C B A]
	POPJ P,

GSTSER:	TYPE BARF:
	MOVE D,A
	MOVEI C,DIBSTS
	PUSHJ P,TYPSTS
	JRST GSTS3		;DON'T TRY ANY MORE REGS

TYPSTS:	SETOM FIRST'
TYPST1:	SKIPN B,(C)
	 JRST CRR
	HLLZ T,B		;FLAGS TO TEST
	TDNN D,T
	 AOJA C,TYPST1
	MOVEI A,",
	AOSE FIRST
	 PUSHJ P,TYO
	MOVE A,LINPOS
	CAILE A,TCMXH
	 PUSHJ P,CRR
	PUSHJ P,OUTSTR
	AOJA C,TYPST1

TYPRGN:	LDB A,[360600,,D]	;TYPE NAME OF REGISTER ADDRESSED BY D
	ROT A,-1	
	MOVE B,RHRGTB(A)
	JUMPL A,.+2
	 MOVSS B
	PUSHJ P,OUTSTR
	MOVEI A,"=
	JRST TYO

;TABLE OF DRIVE REGISTERS THAT NEED TO BE DISPLAYED
; LH = REG ADDR, RH = STATUS BITS TABLE ADDR

GSTSRT:	%HRDCL,,[0]
	%HRSTS,,STSSTS
	%HRCYL,,[0]
	%HRCCY,,[0]
	%HRADR,,[0]
	%HROFS,,OFSSTS
	%HRER1,,ER1STS
	%HRER2,,ER2STS
	%HRER3,,ER3STS
LGSTSR==.-GSTSRT
;RH
DEFINE STS A,B/
A,,[ASCIZ \B\] ? TERMIN

; CONI STATUS (LH)

CNLSTS:	STS 400000,AR FULL
	STS 200000,CB FULL
	STS 040000,CC INH
	STS 020000,CHANNEL ACTIVE
	STS 010000,CHANNEL PULSE
	STS 004000,22-BIT CHANNEL
	STS 000400,CXR ILL FUNC
	STS 000200,CXR DRIVE ACCESS ERR
	STS 000004,MEMORY PARITY
	STS 000002,CONTROL WORD PARITY
	STS 000001,NXM
	0

; CONI STATUS (RH)

CNISTS:	STS 400000,DATA BUS PARITY
	STS 200000,DRIVE EXCEPTION
	STS 100000,CHANNEL ERROR
	STS 020000,CHANNEL OVERRUN
	STS 010000,DRIVE RESPONSE ERR
	STS 004000,CXR ILL CMD
	STS 002000,CXR POWER FAIL
	STS 000200,CONTROL BUS OVERRUN
	STS 000100,RAE INTR
	STS 000040,ATTN INTR
	STS 000020,BUSY
	STS 000010,DONE
	0

; REGISTERS

ZZ==-1
XX==0
YY==0
DEFINE REG N,T/
IFLE N-ZZ, .ERR REG OUT OF ORDER
REPEAT N-ZZ-1, REGH [ASCIZ\????\]
	REGH [ASCIZ\T\]
TERMIN

DEFINE REGH [A]
ZZ==ZZ+1
IFE XX, YY==A
IFN XX, YY,,A
XX==1-XX
TERMIN

RHRGTB:	REG 0,DRV CTL
	REG 1,DRV STATUS
	REG 2,DRV ER1
	REG 3,DRV MAINT
	REG 4,ATTENTION
	REG 5,DRV TRACK-SECTOR
	REG 6,DRV TYPE
	REG 7,DRV LOOK-AHEAD
	REG 10,DRV SERIAL NO
	REG 11,DRV OFFSET
	REG 12,DRV DESIRED CYL
	REG 13,DRV CURRENT CYL
	REG 14,DRV ER2
	REG 15,DRV ER3
	REG 16,DRV ECC POS
	REG 17,DRV ECC PAT
	REG 40,CONTROL
	REG 44,INTR ADDR
	REG 50,DATA BUFFER
	REG 54,RAE STATUS
	REG 74,CHANNEL BUFFER
	REG 100,FOO
LOC RHRGTB+40
EXPUNGE REG,REGH,XX,YY,ZZ

; BITS IN DIB REGISTER

DIBSTS:	STS 004000,CTL-TO-DRIVE
	STS 002000,CTL BUS TIMEOUT
	STS 001000,CTL BUS PARITY
	STS 000400,DIB DATA LATE
	STS 000200,DIB ILL CMD
	0

; DRIVE STATUS REGISTER

STSSTS:	STS 1,FWD 5 IPS
	STS 2,FWD 20 IPS
	STS 4,INNER GUARD BAND
	STS 10,GO REVERSE
	STS 20,DIFF < 64
	STS 40,DIFF = 1
	STS 100,VOLUME VALID
	STS 200,DRIVE READY
	STS 400,CONN THIS CTRLR
	STS 2000,LAST SECTOR XFERD
	STS 4000,WRITE LOCK
	STS 10000,MEDIUM ONLINE
	STS 20000,POSITIONING IN PROGRESS
	STS 40000,ERR
	STS 100000,ATTENTION
	0

; DRIVE ERROR REGISTER 1

ER1STS:	STS 1,ILL FUNC
	STS 2,ILL REG
	STS 4,REG MOD REFUSE
	STS 10,BUS PARITY ERR
	STS 20,PACK FORMAT ERR
	STS 40,WRITE CLOCK FAIL
	STS 100,ECC HARD ERR
	STS 200,HEADER WRONG
	STS 400,HEADER CRC ERR
	STS 1000,ADDR OVERFLOW
	STS 2000,INVALID ADDR
	STS 4000,WRITE LOCK ERR
	STS 10000,DRV TIMING ERR
	STS 20000,OP NOT COMPLETE
	STS 40000,UNSAFE
	STS 100000,DATA CHECK
	0

; DRIVE ERROR REGISTER 2

ER2STS:	STS 1,WRITE CURRENT UNSAFE
	STS 2,CURRENT SINK FAILURE
	STS 4,WRITE SELECT UNSAFE
	STS 10,CURRENT SWITCH UNSAFE
	STS 20,MOTOR SEQUENCE ERR
	STS 40,TRANSITIONS DET FAIL
	STS 100,TRANSITIONS UNSAFE
	STS 200,"UNSAFE EXCEPT R/W"
	STS 400,WRITE READY UNSAFE
	STS 1000,MULTIPLE HEAD SELECT
	STS 2000,NO HEAD SELECT
	STS 4000,INDEX ERROR
	STS 10000,30 VOLT UNSAFE
	STS 20000,PHASE LK OSC UNSAFE
	STS 100000,AC UNSAFE
	0

; DRIVE ERROR REGISTER 3

ER3STS:	STS 1,PACK SPEED UNSAFE
	STS 2,VELOCITY UNSAFE
	STS 10,UNSAFE EXCEPT R/W
	STS 40,AC LOW
	STS 100,DC LOW
	STS 40000,SEEK INCOMPLETE
	STS 100000,OFF CYLINDER
	0

; DRIVE OFFSET REGISTER

OFSSTS:	STS 2000,HDR COMPARE INH
	STS 4000,ECC INHIBIT
	STS 10000,PDP-11 FORMAT
	0
];RH

IFN T300P,[
;PRINT STATUS OF T300 (ERROR FROM LAST COMMAND)
;LATER THIS WILL BE INTEGRATED INTO GSTS
T300ST:	MOVEI P,PDL
	PUSH P,[DDT]
T3STS:	INSIRP PUSH P,[A B C D T I K] 
	TYPE T-300 AND 2561 STATUS: 
	SKIPN D,DSCFLT
	 JRST T3STS2
	TRNN D,%DFRST+%DFCQE+%DFNXM+%DFPAR
	 JRST T3STS1
	MOVEI C,[	STS %DFRST,CONTROLLER POWER-CYCLED AND RESET
			STS %DFCQE,COMMAND-QUEUE ERROR
			STS %DFNXM,RQB NXM
			STS %DFPAR,RQB PARITY ERROR
			0 ]
	MOVSS D			;TYPSTS WANTS BITS IN LEFT HALF
	PUSHJ P,TYPSTS
	TYPE , PDP-11 ERROR ADDRESS=
	LDB A,[000200,,DSCFLT]
	LSH A,16.
	IOR A,DSCSTS
	PUSHJ P,TOPT
T3STS9:	PUSHJ P,CRR
	JRST GSTS3

;FAULT CODE
T3STS1:	CAILE D,17
	 JRST [	TYPE ILLEGAL FAULT CODE=
		MOVE A,D
		PUSHJ P,TOPT
		JRST T3STS9 ]
	MOVE B,(D)[	[ASCIZ/FAULT CODE 0?/]
			[ASCIZ/DRIVE NOT READY/]
			[ASCIZ/ILLEGAL HEAD OR SECTOR/]
			[ASCIZ/SEEK TIMEOUT/]
			[ASCIZ/DISK STATUS BAD AFTER ON-CYLINDER (FAULT CODE 4)/]
			[ASCIZ/TIME OUT WRITING SECTOR ID (FAULT CODE 5)/]
			[ASCIZ/FIFO ERROR IN FORMAT WRITE (FAULT CODE 6)/]
			[ASCIZ/WRITE TIMEOUT (FAULT CODE 7)/]
			[ASCIZ/SEEK TIMEOUT (FAULT CODE 10)/]
			[ASCIZ/HEADS NOT LOADED/]
			[ASCIZ/READ TIMEOUT (FAULT CODE 12)/]
			[ASCIZ/INDEX TIMEOUT (FAULT CODE 13)/]
			[ASCIZ/SECTOR TIMEOUT (FAULT CODE 14)/]
			[ASCIZ/FAULT CODE 15?/]
			[ASCIZ/DMA TIMEOUT (FAULT CODE 16)/]
			[ASCIZ/DMA TIMEOUT IN ECC (FAULT CODE 17)/] ]
	PUSHJ P,OUTSTR
	PUSHJ P,CRR
;COMMAND OK, CHECK ORDINARY ERROR STATUS
T3STS2:	MOVE D,DSCSTS
	MOVEI C,[	STS %DSRTR,COMMAND WAS RETRIED
			STS %DSECH,UNCORRECTABLE DATA ERROR
			STS %DSECC,CORRECTED DATA ERROR
			STS %DSIDE,ID ERROR
			STS %DSHCE,HEADER COMPARE ERROR
			STS %DSPRT,WRITE-PROTECTED SECTOR
			STS %DSALT,ALTERNATE-SECTOR FLAG
			STS %DSOVR,OVERRUN
			STS %DSSKE,SEEK ERROR
			STS %DSOFL,DRIVE OFF-LINE OR FAULT
			STS %DSFLT,DRIVE FAULT
			STS %DSNXM,PDP11 MEMORY NXM
			STS %DSPAR,PDP11 MEMORY PARITY ERROR
			STS %DSSFL,SYSTEM FAULT
			STS %DSWLK,DRIVE WRITE-LOCKED
			0 ]
	MOVSS D			;TYPSTS WANTS D IN LEFT HALF
	PUSHJ P,TYPSTS
	PUSHJ P,CRR		;NOW SHOW DISK COMMAND AND ADDRESS
	TYPE DISK COMMAND:
	MOVE A,DSCCMD
	PUSHJ P,TOPT
	PUSHJ P,TSPAC
	MOVEI B,[ASCIZ/(UNKNOWN?)/]
	CAIN A,%DMSNS
	 MOVEI B,[ASCIZ/(SENSE)/]
	CAIN A,%DMTST
	 MOVEI B,[ASCIZ/(DIAGNOSTICS)/]
	CAIN A,%DMREC
	 MOVEI B,[ASCIZ/(RECALIBRATE)/]
	CAIN A,%DMSEK
	 MOVEI B,[ASCIZ/(SEEK)/]
	CAIN A,%DMWRT
	 MOVEI B,[ASCIZ/(WRITE)/]
	TRNE A,%DMRED
	 JRST [ CAIG A,%DMRED+10
		 MOVE B,(A)[	[ASCIZ/(READ)/]
				[ASCIZ/(READ EARLY-DATA-STROBE)/]
				[ASCIZ/(READ LATE-DATA-STROBE)/]
				[ASCIZ/(READ POSITIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ NEGATIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ EARLY-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ EARLY-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ LATE-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
				[ASCIZ/(READ LATE-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
			    ]-%DMRED
		JRST .+1 ]
	PUSHJ P,OUTSTR
	TYPE , DRIVE=
	MOVE A,DSCDRV
	PUSHJ P,TOPT
	TYPE , CYL=
	MOVE A,DSCCYL
	PUSHJ P,TOPT
	TYPE , HEAD=
	MOVE A,DSCHED
	PUSHJ P,TOPT
	TYPE , SEC=
	MOVE A,DSCSEC
	PUSHJ P,TOPT
	JRST T3STS9
];T300P

SUBTTL READ & TYPE OUT HEADERS

DC,[	;FOR NOW, DC10 ONLY
RDHDHD==20		;2WORDS PER SEC, MANY SECS

RDHEAD:	JSR INIT	;READ ALL HEADERS ON A TRACK
	PUSHJ P,CRR
	UNTMES UNIT=
	PUSHJ P,GETNUM
	 JRST RDHEAD
	CAIL A,NUNITS
	 JRST RDHEAD
	MOVEM A,TOU
	MOVE I,A
	PUSHJ P,RESET
RDHD1:	TYPE CYL=
	PUSHJ P,GETNUM
	 JRST DDT
	CAIL A,NCYLS+XCYLS
	 JRST RDHD1
	SKIPGE QTRAN(I)
	 ADDI A,NCYLS+XCYLS
	DPB A,[DCYL READHD]
	TYPE SURF=
	PUSHJ P,GETNUM
	 SETZ A,
	CAIL A,NHEDS
	 JRST RDHD1
	DPB A,[DSURF READHD]
	DATAO DC0,[DJMP READHD]
	CONSZ DC0,DSSACT
	 JRST .-1
	CONSZ DC0,DSSERR
	 JRST [	TYPE ERROR---
		JRST GETSTS]
	SETOM SECT0'
	SETOM FIRST
	SETZ T,
RDHD2:	MOVE D,HEADBF(T)
	TLZ D,777000
	CAMN D,SECT0
	 JRST RDHD1			;GONE AROUND ONCE
	AOSN FIRST
	 MOVEM D,SECT0
	TYPE PKID=
	LDB A,[DPKID HEADBF(T)]
	PUSHJ P,TOPT
	PUSHJ P,TCOMMA
	MOVE D,HEADBF(T)
	PUSHJ P,TYPLOC
	PUSHJ P,CRR
	MOVE A,HEADBF+1(T)
	TLNE A,1000			;INDIRECT BIT OF HEADER
	 JRST [	MOVEI A,"@
		PUSHJ P,TYO
		MOVE D,HEADBF+1(T)
		PUSHJ P,TYPLOC
		JRST RDHD6]
	TYPE LENGTH=
	MOVN A,HEADBF+1(T)
	LDB A,[1600,,A]			;LENGTH FIELD
	PUSHJ P,TOPT
	LDB A,[270200,,HEADBF+1(T)]	;ANY NEXT-ADDRESS CODE?
	JUMPE A,RDHD3
	MOVE B,NXTADR(A)
	PUSHJ P,OUTSTR
RDHD3:	MOVE A,HEADBF+1(T)
	TLNE A,200
	 JRST [	MOVEI B,[ASCIZ /,WRITE PROTECT/]
		PUSHJ P,OUTSTR
		JRST .+1]
RDHD6:	SETO C,		;PARITY
	HRLI T,-2
RDHD4:	MOVEI D,14.
	MOVE A,HEADBF(T)
	XORM A,C
	LSH A,-2
	SOJG D,.-2
	AOBJN T,RDHD4
	TRNN C,3		;BOTH ODD?
	 JRST RDHD5
	MOVEI B,[ASCIZ /,BAD PARITY!!/]
	PUSHJ P,OUTSTR
RDHD5:	PUSHJ P,CRR
	CAIL T,RDHDHD*NSECS
	 JRST RDHD1
	JRST RDHD2

READHD:	DSPC+DSWIDX+DSWNUL+DSCRHD	;WAIT FOR INDEX, THENREAD HEADERS
	QCOPY HEADBF,RDHDHD*NSECS
	DHLT

HEADBF:	BLOCK RDHDHD*NSECS

TCOMMA:	MOVEI A,",
	JRST TYO

NXTADR:	0
	[ASCIZ /,END-OF-TRACK/]
	[ASCIZ /,END-OF-CYLINDER/]
	[ASCIZ /,END-OF-DISC/]

TYPLOC:	TYPE CYL=
	LDB A,[DCYL D]
	PUSHJ P,TOPT
	TYPE ,SURF=
	LDB A,[DSURF D]
	PUSHJ P,TOPT
	TYPE ,SECT=
	LDB A,[DSECT D]
	JRST TOPT

GETNUM:	SETZ C,
	SETOM FIRST
GETNM1:	PUSHJ P,TYI
	CAIL A,"0
	CAILE A,"9
	 JRST [	MOVE A,C
		SKIPL FIRST
		 AOS (P)
		JRST CRR]
	AOS FIRST
	IMULI C,10
	ADDI C,-"0(A)
	JRST GETNM1
];DC

SUBTTL DRIVE RESET

NTS,[
DC,[
RECAL:	CONO DC0,DCCSET+DCDENB
	MOVE T,QTRAN(I)
	SKIPL DRIVE(T)		;SKIP IF DRIVE NOT KNOWN TO BE DEAD ALREADY
	 JRST [	SETZM QACT(I)
		POPJ P,]
	DPB T,[DUNFLD DRST]
	DPB T,[DUNFLD STOSTS]
	DATAO DC0,[DJMP STOSTS]
	CONSZ DC0,DSSACT
	 JRST .-1
	MOVE T,STATUS
	TDNN T,[DDSONL]		;ON LINE
	 JRST OFFL1
	DATAO DC0,DRST
	CONSO DC0,DSSATT
	 JRST .-1
	CONSO DC1,20		;OFF LINE OR MULTIPLE SELECT
	 POPJ P,
OFFL1:	SETZM QACT(I)
	SKIPE GOGOX
	 POPJ P,		;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE Drive off line #
	PUSH P,A
	HRRZ A,QTRAN(I)
	SETZM DRIVE(A)
	PUSHJ P,DPT
	POP P,A
	PUSHJ P,CRR
	POPJ P,
];DC

RP,[
RESET:	PUSH P,A
	CONSZ	DPC,BUSY
	 JRST	.-1
	DATAO	DPC,[DEASEC 776]
	DPB	I,[DUNFLD DRST]
	DATAO	DPC,DRST
RESET0:	DATAI	DPC,T
	TLNE T,20
	 JRST RESET1
	SKIPE GOGOX
	 JRST RESET9	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE  OFF LINE #
	MOVE A,I
	PUSHJ P,DPT
	PUSHJ P,CRR
	JRST RESET9

RESET1:	TLNN T,4
	 JRST RESET2
	SKIPE GOGOX
	 JRST RESET9	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE  NO SUCH DRIVE #
	MOVE A,I
	PUSHJ P,DPT
	PUSHJ P,LCRR
	JRST RESET9

RESET2:	TRNN	T,776
	 JRST RESET0
	DATAO	DPC,[DEASEC 776]
	JRST POPAJ

RESET9:	SETZM QACT(I)		;THIS DRIVE LOST
	JRST POPAJ

DRST:	DRCALC
];RP

DC,[
RESET:	PUSHJ P,RECAL
	MOVE T,QTRAN(I)		;GET PACK ID FROM HARDWARE
	DPB T,[DUNFLD GPKID]
	MOVEI T,TUTCYL
	SKIPGE QTRAN(I)
	 ADDI T,NCYLS+XCYLS
	DPB T,[DCYL GPKID]
	CONO DC0,DCCSET+DCDENB
	DATAO DC0,[DJMP GPKID]
	CONSZ DC0,DSSACT
	 JRST .-1
	LDB T,[DPKID RPKID]
	MOVEM T,PKNUM(I)
	POPJ P,

DRST:	DSPC+DSRCAL+DSWINF+DUNENB
GPKID:	DSPC+DSCRHD+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
	DCOPY RPKID(37774)
	DHLT
];DC
];NTS

TS,[
RESET:	PUSH P,A
	HRRZ A,QTRAN(I)
	SKIPL DRIVE(A)
	 JRST OFFL2
	CAML I,NQS
	 JRST OFFL2
	HRRZ A,SQACT		;SYSTEM QACT TABLE
	ADD A,I
	MOVSS A
	HRRI A,A
	.GETLOC A,		;COPY SYSTEMS QACT
	SKIPE A			;0 MEANS ON-LINE TO ITS
	 JRST OFFLIN
	POP P,A
	POPJ P,


OFFLIN:	TYPE Drive off line #
	HRRZ A,QTRAN(I)
	SETZM DRIVE(A)
	PUSHJ P,DPT
	PUSHJ P,CRR
OFFL2:	SETZM QACT(I)
	POP P,A
	POPJ P,
];TS

NTS,[
RH,[
RESET:	MOVE T,QTRAN(I)			;GET PHYS DRIVE
IFN T300P,[
	CAIL I,T300P
	 JRST T3RST
];T300P
	SKIPL DRIVE(T)
	 JRST [	SETZM QACT(I)		;DRIVE ALREADY KNOWN TO BE DOWN
		POPJ P, ]
	PUSH P,A
	MOVE A,[%HRDCL,,%HMCLR]		;CLEAR THE DRIVE
	PUSHJ P,RHSET
	 JRST RESETL			;HMM, NO DRIVE
	MOVE A,[%HRDCL,,%HMRDP]		;I SAID, "CLEAR THE DRIVE"!
	PUSHJ P,RHSET
	 JRST RESETL
	MOVE A,[%HROFS,,0]		;CLEAR THE FRIGGING DRIVE!!!
	PUSHJ P,RHSET
	 JRST RESETL
	MOVSI A,%HRTYP			;GET DRIVE TYPE
	PUSHJ P,RHGET
	 JRST RESETL			;??
	TRNE A,140000
	 JRST RESETL			;TAPE?
	TRNN A,020000
	 JRST RESETL			;FIXED HEADS?
	MOVE A,[%HRDCL,,%HMACK]		;PACK ACKNOWLEDGE
	PUSHJ P,RHSET
	 JRST RESETL
	MOVSI A,%HRSTS
	PUSHJ P,RHGET
	 JRST RESETL
	TRNN A,%HSMOL
	 JRST RESET4			;PACK NOT MOUNTED
	MOVE A,[%HRDCL,,%HMREC]		;RECALIBRATE
	PUSHJ P,RHSET
	 JRST RESETL
	MOVEI B,80000.			;A LITTLE OVER 1/2 SEC
RESET0:	MOVSI A,%HRSTS			;GET STATUS
	PUSHJ P,RHGET
	 JRST RESETL			;DRIVE VANISHED?
	TRNE A,%HSERR
	 JRST RESETL			;GOT ERROR RECALIBRATING?
	TRC A,%HSVV+%HSMOL+%HSRDY	;CHECK FOR GOOD BITS
	TRCE A,%HSVV+%HSMOL+%HSRDY
	 SOJG B,RESET0			;BITS NOT ALL ON, WAIT MORE
	JUMPG B,RESET5			;WON.
					;TIMED OUT, FALL INTO RESETL

RESETL:	SETZM QACT(I)			;LOST
	SKIPE GOGOX
	 JRST POPAJ	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	CONSZ DSK,%HIDRE
	 JRST RESET1
	CONSZ DSK,%HIILC
	 JRST RESET2
	TYPE MISC ERROR DRIVE #
	MOVEI A,GSTS			;CALL GSTS BEFORE RETURNING
	EXCH A,(P)
	PUSH P,A
	JRST RESET3

RESET2:	TYPE ILC OR RAE DRIVE #
	JRST RESET3

RESET1:	TYPE DRIVE NOT PRESENT #
RESET3:	HRRZ A,QTRAN(I)
	X DPT
	X CRR
	JRST POPAJ

RESET4:	SETZM QACT(I)
	SKIPE GOGOX
	 JRST POPAJ	;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
	TYPE DRIVE OFF LINE #
	JRST RESET3

RESET5:	SKIPE MARKF
	 JRST POPAJ			;PACK NOT FORMATTED YET
	MOVSI A,%HRCYL
	HRRI A,TUTCYL
	PUSHJ P,RHSET
	 JRST RESETL
	MOVSI A,%HRADR
	PUSHJ P,RHSET
	 JRST RESETL
	MOVE A,[-2_4,,SLVIOWD-1]
	MOVEM A,SLVICWA
	SETZM SLVICWA+1
KL,[	SWPUO 0
	CONSZ APR,200000
	 JRST .-1
]
	MOVE A,[%HRCTL,,SLVICWA_6+%HMRHD]
	PUSHJ P,RHSET
	 JRST RESETL
	CONSO DSK,%HIDONE
	 JRST .-1
	CONSZ DSK,%HIERR
	 JRST RESETL
	HRRZ A,SLVIOWD+1		;GET I.T.S. PACK NUMBER
	MOVEM A,PKNUM(I)
	JRST POPAJ
];RH

IFN T300P,[
T3RST:	PUSH P,D
	MOVEI D,%DMSNS		;FIRST, SENSE STATUS (RECALIBRATE HANGS IF
	PUSHJ P,T3CMD		; DRIVE OFF LINE, AND TIMEOUT LEAVES 11 WEDGED)
	JUMPL T,T3RSTL		;TIMEOUT, 11 MUST BE DOWN
	TDNE T,[%DFRST,,%DSOFL+%DSSFL]
	 JRST T3RSTL		;DRIVE OFF-LINE, LEAVE IT ALONE
	MOVEI D,%DMREC		;SEND A RECALIBRATE
	PUSHJ P,T3CMD
	JUMPN T,T3RSTL		;JUMP IF ERROR
	SETOM PKNUM(I)		;PACK NUMBER NOT GOTTEN FROM HARDWARE!
	POP P,D
	POPJ P,

T3RSTL:	SETZM QACT(I)		;OFF LINE
	POP P,D
	SKIPN GOGOX
	 JRST T3STS
	POPJ P,

;DO COMMAND IN D ON DRIVE NUMBER IN I, RETURN STATUS IN T (0 IF OK)
;LH(T) GETS DSCFLT, RH(T) GETS DSCSTS
;YOU MUST SET UP DSCCYL, ETC. BEFORE CALLING
T3CMD:	MOVEI T,2561
	MOVEM T,DSCCHK
	MOVEM D,DSCCMD
	MOVEI T,-T300P(I)
	MOVEM T,DSCDRV
	SETZM DSCDON
KL,[	SWPUO 0			;UNLOAD PAGE 0 FROM THE CACHE
	CONSZ APR,200000
	 JRST .-1
];KL
	MOVEI T,1
	MOVEM T,DSCREQ
KL,[	SWPUO 0			;UNLOAD PAGE 0 FROM THE CACHE
	CONSZ APR,200000	;AGAIN SO 11 WILL SEE DSCREQ ON IN INTERRUPT
	 JRST .-1
];KL
	CONO DLC,100040		;INTERRUPT 11
	MOVEI T,60000.		;I THINK THIS TIMEOUT IS ABOUT 3 SECONDS
				;UNFORTUNATELY, THIS TIMEOUT DOESN'T WORK ANYWAY
				;REALLY, BECAUSE IF DRIVE 0 IS OFFLINE THE
				;CONTROLLER HANGS AND EXECUTES COMMANDS WRONG
				;AND OTHERWISE LOSES ITS ASS.
T3CMD1:
KL,[	SWPUO 0			;UNLOAD PAGE 0 FROM THE CACHE
	CONSZ APR,200000	;AGAIN SO DSCDON GETS PICKED UP FROM MAIN MEMORY
	 JRST .-1
];KL
	SKIPN DSCDON
	 SOJG T,T3CMD1
	JUMPLE T,[ MOVSI T,(SETZ)	;SIGNAL TIMEOUT (DRIVE OFFLINE?)
		   POPJ P, ]	;DSCFLT & DSCSTS WILL SAY NON-ERROR
	SETZM DSCDON
	CONO DLC,10		;11 IS TRYING TO INTERRUPT -10, TURN IT OFF
	HRLZ T,DSCFLT
	HRR T,DSCSTS
	TRZE T,%DSRTR+%DSECC	;THESE ARE NOT ERRORS	
	 AOS CERRS
	POPJ P,
];T300P
];NTS

SUBTTL READ & WRITE TUT

;DISK NUMBER IN I, CORE ADDR IN A, ERROR RETURN HAS T NEGATIVE

WRTUT:
TS,	JRST SUCCESS
NTS,[	MOVE J,MFDBK
	SUB J,NTBL(I)
WRTUT0:	PUSHJ P,WRITE
	JUMPL T,CPOPJ
	ADDI A,2000
	ADDI J,1
	CAMGE J,MFDBK
	 JRST WRTUT0
	POPJ P,
];NTS

RDTUT:
NTS,[	MOVE J,MFDBK
	SUB J,NTBL(I)
RDTUT0:	PUSHJ P,READ
	JUMPL T,CPOPJ
	ADDI A,2000
	ADDI J,1
	CAMGE J,MFDBK
	 JRST RDTUT0
	POPJ P,
];NTS
TS,[	TUTPAG==600000			;READ TUT BY MAPPING IN ABS PAGE
	MOVE T,NTBL(I)			;SIZE OF TUT ON THIS DRIVE
	MOVE J,[SQUOZE 0,QTUTO]		;AND WHERE ARE THEY LOCATED?
	.EVAL J,
	 .VALUE
	PUSH P,A
	PUSH P,I
	ADD J,I				;-> -> FIRST BLOCK THIS TUT
	MOVSS J
	HRRI J,J
	.GETLOC J,
	HRRZS J
	LSH J,-10.			;FIRST BLOCK# OF TUT
	MOVN I,T
	HRL J,I				;AOBJN PTR FOR BLOCKS OF THIS TUT
RDTUT1:	.CALL [	SETZ
		'CORBLK
		MOVEI 210000		;READ ONLY
		MOVEI -1		;INTO SELF
		MOVEI TUTPAG/2000
		MOVEI 400000		;FROM SYSTEM
		SETZI (J) ]
	 .VALUE
	MOVSI I,TUTPAG
	JRST RDTUT3

RDTUT3:	HRRI I,(A)
	BLT I,1777(A)			;COPY IN A BLOCK OF TUT
	ADDI A,2000
	AOBJN J,RDTUT1
	POP P,I
	POP P,A
	SKIPGE QPKNUM(A)
	 .VALUE				;OLD FORMAT?
	SKIPN QLASTB(A)
	 .VALUE				;OLDER FORMAT?
	JRST SUCCESS
];TS

SUBTTL DISK I/O

WRITT:	MOVE I,TOU
WRITE:	HRRZM J,LBLK'
TS,[	HRRZ TT,I
	CAML TT,NQS
	 .VALUE
	HRRZ TT,J
	CAIGE TT,TBLKS
	SKIPGE TT
	 .VALUE
	JRST SUCCESS
];TS
DC,[	SKIPA T,[DWR]
READ:	 MOVEI T,DRD	;A/ CORE LOCN, I/ DRIVE  J/TRACK #
	HRRM T,DGO
	HRRZM J,BLK
	MOVEM I,UNIT
	HRRZ TT,I
	CAIL TT,NUNITS
	 JRST 4,.
	HRRZ TT,J
	CAIGE TT,TBLKS
	SKIPGE TT
	 JRST 4,.
	MOVE TT,QTRAN(I)		;GET PHYSICAL DRIVE #
	DPB TT,[DUNFLD (T)]
	DPB A,[DCCA 1(T)]
	DPB A,[DCCA 4(T)]
	HRRZ TT,J
	CAIL TT,NBLKS+XBLKS
	 JRST 4,.
	IDIVI TT,NSECS
	DPB T,[DSECT @DGO]
	IDIVI TT,NHEDS
	DPB T,[DSURF @DGO]
	MOVE T,TT
	SKIPGE QTRAN(I)
	 ADDI T,NCYLS+XCYLS		;MAP INTO 2ND HALF OF CALCOMP
	DPB T,[DCYL @DGO]
	MOVE T,PKNUM(I)
	CAIL TT,NCYLS
	 MOVEI T,0
	DPB T,[DPKID @DGO]
	HRRZ TT,DGO
	MOVE T,(TT)
	TLZ T,340000	;CHANGE TO READ COMPARE
	MOVEM T,3(TT)
RW1:	MOVEI T,30.
	SKIPE HCRASH
	 MOVEI T,0		;SPEED IS OF THE ESSENCE - TRY ONLY ONCE
RW2:	CONO DC0,DCCSET\DCDENB
	DATAO DC0,DGO
	MOVSI TT,3		;WAIT AT MOST 3 SECONDS
	CONSZ DC0,DSSACT
	 SOJGE TT,.-1
	JUMPL TT,[ PUSH P,T
		   X RECAL
		   POP P,T
		   JRST .+2 ]
	CONSZ DC0,DSSERR
	 SOJGE T,RW2
	SKIPGE T
	 AOS FERRS
	POPJ P,

DGO:	DJMP .

DRD:	DREAD+DUNENB
	DCOPY .(-2000_2&37774)
	DCOPY RXWDS(-4_2&37774)
	DRC
	DCCOMP .(-2000_2&37774)
	DCCOMP RXWDS (-4_2&37774)
	DHLT

DWR:	DWRITE+DUNENB
	DCOPY .(-2000_2&37774)
	DCOPY WXWDS(-4_2&37774)
	DRC
	DCCOMP .(-2000_2&37774)
	DCCOMP WXWDS(-4_2&37774)
	DHLT
];DC

TS,[
READ:	HRRZ TT,I
	CAIL TT,NUNITS
	 .VALUE
	HRRZ TT,J
	CAMN TT,MFDBK
	 JRST [	.OPEN QIN,[.BII,,'DSK
			   SIXBIT /M.F.D./
			   SIXBIT /(FILE)/]
		 .VALUE
		JRST RDIN]
	CAML TT,NUDS
	 .VALUE			;SOME RANDOM DISK BLOCK
	.SUSET [.SSNAM,,USRNAM]
	.OPEN QIN,[.BII,,'DSK
		   SIXBIT /.FILE./
		   SIXBIT /(DIR)/]
	 .VALUE
RDIN:	HRLI A,-2000
	.IOT QIN,A
	.CLOSE QIN,
SUCCES:	MOVEI T,30.
	POPJ P,
];TS
RP,[	;RP10 I/O - FALL IN FROM WRITE
	SKIPA T,DWR
READ:	 MOVE T,DRD
	MOVEM T,RPIOOP
	HRRZ TT,J
	CAIL TT,MBLKS+XBLKS
	 JRST 4,.
	IMULI TT,SECBLK
	IDIVI TT,NSECS
	MOVEM T,RPIOSC
	IDIVI TT,NHEDS
	MOVEM T,RPIOHD
	MOVEM TT,RPIOCY
	MOVEM A,RPAOBJ
	MOVNI T,2000
	HRLM T,RPAOBJ
	JRST RPIO		;DO IT

DRD:	DREADC+SLVICWA+5000	;DISABLE PARITY ERROR STOPS
DWR:	DWRITC+SLVICWA

;VARIABLES SET UP TO CONTROL TRANSFER
;WHEN AN ERROR OCCURS, IT GOES INTO SECTOR AT A TIME MODE, AND 
;THESE VARIABLES ARE STEPPED ALONG TO REFLECT THAT.
RPAOBJ:	0	;AOBJN POINTER TO WORDS TO BE TRANSFERRED
RPIOCY:	0	;CYLINDER TO START AT
RPIOHD:	0	;HEAD TO START AT
RPIOSC:	0	;SECTOR TO START AT
RPIOOP:	0	;COMMAND WORD. SLVICWA ALREADY ADDED IN
;UNIT IS IN I

;HIGH-LEVEL I/O ROUTINE.  TRIES TO DO IT ALL AT ONCE,
;IF THAT LOSES TWICE TRIES IT A SECTOR AT A TIME.
;IF HCRASH IS SET, TRY ONLY ONCE.
;SMASHES T, TT.  RETURNS T NEGATIVE IF ERROR.
RPIO:	PUSH P,A
	SETZM SLVIOWD+1
	MOVE T,RPAOBJ
	SOS T
	MOVEM T,SLVIOWD
	PUSHJ P,RPXIO		;TRY IT
	 JRST RPIO1
	MOVEI T,102		;WON
	JRST RPIO9

RPIO1:	SETOM T
	SKIPE HCRASH
	 JRST RPIO9		;GIVE UP IF HCRASH
	PUSHJ P,RPRCAL		;RECALIBRATE, THEN
	PUSHJ P,RPXIO		;TRY IT AGAIN
	 JRST RPIO2
	MOVEI T,101		;WON
RPIO9:	SKIPGE T
	 AOS FERRS
	POP P,A
	POPJ P,

;SECTOR AT A TIME MODE
RPIO2:	MOVEI T,100
	SKIPL TT,RPAOBJ
	 JRST RPIO9		;TRANSFER EXHAUSTED, WON
	SOS TT
	HRLI TT,-200
	MOVEM TT,SLVIOWD
	MOVEI T,10.		;TRY THIS SECTOR 10 TIMES
	PUSHJ P,RPXIO
	 SOJGE T,.-1
	JUMPL T,RPIO9		;GIVE UP
	MOVE T,[200,,200]	;ADVANCE TO NEXT SECTOR
	ADDM T,RPAOBJ
	AOS T,RPIOSC
	CAIGE T,NSECS
	 JRST RPIO2
	SETZM RPIOSC
	AOS T,RPIOHD
	CAIGE T,NHEDS
	 JRST RPIO2
	SKIPL RPAOBJ
	 JRST RPIO2
	JRST 4,.		;CYLINDER OVERFLOW?

;LOW-LEVEL IO, JUST DO THE OPERATION SPECIFIED IN THE VARIABLES.
;CLOBBER A,TT.
;SKIP IF SUCCESS.
RPXIO:	MOVEI TT,SLVIOWD	;SET UP DF10 COMMAND
	HRRZM TT,SLVICWA
	SETZM SLVICWA+1
	PUSH P,T
	PUSHJ P,SEEK		;MAKE SURE AT DESIRED CYLINDER
	 JRST POPTJ		;SEEK FAILED
	POP P,T
	MOVE A,RPIOOP		;SET UP RP10 DATAO
	DPB I,[DUNFLD A]
	MOVE TT,RPIOCY
	DPB TT,[DCYL A]
	LSH TT,-8		;FOR RP03
	DPB TT,[DCYLXB A]
	MOVE TT,RPIOHD
	DPB TT,[DSURF A]
	MOVE TT,RPIOSC
	DPB TT,[DSECT A]
	CONO DPC,DCLEAR
	SKIPN HCRASH		;IF HCRASH, MAY BE MONITORING SOMETHING IN LIGHTS?
	 DATAO LIGHTS,A
	DATAO DPC,A		;ISSUE COMMAND
	CONSO DPC,DONE		;AWAIT DONE
	 JRST .-1
	CONSZ DPC,ALLER		;SKIP-RETURN UNLESS ERROR
	 POPJ P,
	HLRO TT,RPAOBJ		;SEEMS SUCCESSFUL, CHECK THE CHANNEL CONTROL WORD STORED
	HRRZ A,RPAOBJ
	SUB A,TT		;SUPPOSED END OF TRANSFER
	HRRZ TT,SLVICWA+1
	CAIE A,1(TT)
DF10FK:	 POPJ P,		;CHANNEL TRYING TO FUCK YOU OVER
	JRST POPJ1

;RECALIBRATE UNIT IN I, SMASHES T,TT
RPRCAL:	CONO DPC,DCLEAR
	MOVE T,[DEASEC 776]
	DPB I,[DUNFLD T]	;LEAVE PROPER UNIT SELECTED FOR GETSTS
	DATAO DPC,T		;CLEAR ATTNS
	DPB I,[DUNFLD DRST]	
	DATAO DPC,DRST
RPRCL1:	DATAI DPC,TT
	TLNN TT,(ONLINE)
	 POPJ P,		;OFF LINE
	TLNE TT,(NSCHDR)
	 POPJ P,		;NO SUCH DRIVE
	TRNN TT,776
	 JRST RPRCL1		;AWAIT ATTENTION
	DATAO DPC,T		;GOT ATTENTION, CLEAR IT
RPRCL2:	TLNE TT,(ONCYL+SKINC)
	 POPJ P,		;DONE
	DATAI DPC,TT
	JRST RPRCL2		;ON CYLINDER SOMETIMES TAKES A WHILE TO SET

;SEEK TO CYLINDER IN RPIOCY ON UNIT I, SMASHES T,TT, SKIPS ON SUCCESS.
SEEK:	MOVEI TT,10.
	MOVEM TT,SEEKC
SEEK1:	CONSZ DPC,BUSY
	 JRST .-1
	DATAO DPC,[DEASEC 776]
	MOVSI TT,(DSEEKC)
	DPB I,[DUNFLD TT]
	MOVE T,RPIOCY
	DPB T,[DCYL TT]
	LSH T,-8		;FOR RP03
	DPB T,[DCYLXB TT]
	SKIPN HCRASH
	 DATAO LIGHTS,TT
	CONO DPC,DCLEAR
	DATAO DPC,TT
	MOVE T,[DEASEC 776]
	DPB I,[DUNFLD T]	;LEAVE PROPER UNIT SELECTED FOR GETSTS
	PUSHJ P,RPRCL1		;AWAIT COMPLETION
	TLNE TT,(ONCYL)		;SUCCEED IF ON CYLINDER
	 JRST POPJ1
	SOSGE T,SEEKC		;COUNT FAILURES
	 POPJ P,		;GIVE UP
	PUSHJ P,RPRCAL		;RECALIBRATE
	JRST SEEK1		;AND TRY AGAIN
];RP
RH,[	;RH10 I/O - FALL IN FROM WRITE

;ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
.SEE RHCMD ;VARIABLES CONTROLLING WHAT GOES ON HERE
;INSIDE RW2 TT GENERALLY HAS THE DISK COMMAND AND T HAS THE RETRY COUNT
;ONLY T AND TT CLOBBERED
;ON RETURN T MINUS IF ERROR

	SKIPA TT,[%HMWRT]
READ:	 MOVEI TT,%HMRED
IFN T300P,[
	CAIL I,T300P
	 JRST T3IO
	SETZM T3IOP
];T300P
	MOVEM TT,RHCMD
	HRRZ TT,J
	CAIL TT,TBLKS
	 JRST 4,.
	IDIVI TT,NBLKSC		;TT:=CYLINDER, T:=BLOCKS INTO CYLINDER
	HRLZM TT,RHPGA		;SAVE CYLINDER
	MOVE TT,T		;GET BLOCKS INTO CYLINDER
	IMULI TT,SECBLK		;SECTORS INTO CYLINDER
	IDIVI TT,NSECS		;TT:=HEAD, T:=SECTOR
	LSH TT,8		;FORM ADDRESS WORD
	IOR TT,T
	HRRM TT,RHPGA		;COMPLETE THE ADDRESS
	MOVEI T,-1(A)		;SET UP IOWD TO TRANSFER ONE BLOCK
	HRLI T,-2000
	MOVEM T,RHIOW
;ENTER HERE WITH RHCMD, RHIOW, AND RHPGA SET UP.  I HAS UNIT#.
RW1:	MOVEI T,5		;INIT LOSAGE COUNT
	PUSHJ P,RW2		;TRY
	 JRST RW7		;FAILED
;HERE TO RETURN.  T SAYS WHETHER WINNING OR LOSING.
RW5:	MOVE A,[%HRDCL,,%HMCEN]	;RETURN TO CENTER-LINE IF NECESSARY
	AOSN OFFSTF
	 PUSHJ P,RHSET
	  JFCL
	SKIPGE T
	 AOS FERRS
	MOVE A,RHIOW		;RESTORE A
	MOVEI A,1(A)
	POPJ P,

;HERE IF LOSING.
RW7:	SKIPE HCRASH
	 JRST RWL0		;SPEED IS OF THE ESSENCE, TRY ONLY ONCE
	PUSHJ P,RW2		;HMM, TRY AGAIN
	 JRST RWLOSS		;STILL LOSING, COGITATE
	JRST RW5		;WINNING NOW

RWLOSS:	MOVSI A,%HROFS		;ATTACK OFFSET REGISTER
	HRR A,OFFSTB(T)		;SET APPROPRIATE OFFSET VALUE
	SETOM OFFSTF'		;REMEMBER TO RETURN TO CENTERLINE LATER
	PUSHJ P,RHSET
	 JRST RWL0		;WHAT??
	MOVE A,[%HRDCL,,%HMOFS]
	PUSHJ P,RHSET
	 JRST RWL0
	MOVEI A,20000.		;WAIT 10 MS OR SO FOR GOOD LUCK
	SOJG A,.
	PUSHJ P,RW2		;TRY IT NOW
	 SOJGE T,RWLOSS		;LOSE, TRY WITH DIFFERENT OFFSET
	JUMPGE T,RW5		;WON, SO TAKE WIN RETURN
RWL0:	SETO T,			;COMPLETE LOSS, RETURN NOW
	JRST RW5

OFFSTB:	260
	60
	240
	40
	220
	20
;RH10 I/O ROUTINE PROPER
;FIRST STEP IS TO SET UP CHANNEL COMMAND LIST
RW2:	MOVE TT,RHIOW		;SET UP ADDRESSES
	MOVEM TT,RHTIOW
	MOVE TT,RHPGA
	MOVEM TT,RHTPGA
;RE-ENTER HERE AFTER ECC ERROR
RW2OVR:	PUSH P,B
	PUSH P,C
	MOVE A,[-6,,SLVIOWD]	;POINTS TO WHERE CCWS WILL BE STORED
	HLRO C,RHTIOW		;MINUS NUMBER OF WORDS TO TRANSFER
	MOVNS C			;POSITIVE
	HRRZ B,RHTIOW		;ADDRESS MINUS ONE
RW2CC1:	MOVN TT,C		;WORDS TO TRANSFER IN THIS CCW
	CAIL C,40000-200	;WC IS ONLY A 14-BIT FIELD
	 MOVNI TT,40000-200
	MOVEM B,(A)		;STORE CA
	DPB TT,[$DFWC (A)]	;STORE WC
	ADD C,TT		;LESS WORDS TO DO
	SUB B,TT		;ADVANCE ADDRESS
	AOBJP A,[JRST 4,.]	;ADVANCE CCW PTR, HALT IF TOO BIG!
	JUMPG C,RW2CC1		;NEED MORE WORDS
	SETZM (A)		;END CCW LIST
	HRRZI A,SLVIOWD		;POINT CHANNEL AT IT
	MOVEM A,SLVICWA
	SETZM SLVICWA+1		;INIT FOR CONTROL WORD WRITING
	POP P,C
	POP P,B
	MOVEI A,SLVICWA		;BUILD DATAO CMD
	MOVE TT,RHCMD
	DPB A,[$HCICWA TT]
	TLO TT,%HRCTL		;FILL OUT COMMAND WORD
		;NOW BEFORE GIVING COMMAND CHECK STATUS
	CONSZ DSK,%HIBSY	;WAIT FOR DSK CONTROL
	 JRST .-1
	CONO DSK,%HOCLR		;CLEAR ANY LEFT-OVER ERROR INDICATORS
RW2A:	MOVSI A,%HRSTS		;CHECK DRIVE STATUS
	PUSHJ P,RHGET
	 JRST RW3		;DRIVE VANISHED??
	TRNE A,%HSPIP		;WAIT FOR POSITIONING
	 JRST RW2A		;(MIGHT BE OFFSETTING HEADS?)
	TRNE A,%HSERR		;ANY ERRORS IN DRIVE?
	 JRST RW6		;YES, TRY TO RECOVER
	TRC A,%HSVV+%HSMOL+%HSRDY ;CHECK FOR ALL READY BITS ON
	TRCE A,%HSVV+%HSMOL+%HSRDY
	 JRST RW3		;NOT READY??
	HLRZ A,RHTPGA		;SET CYLINDER
	TLO A,%HRCYL
	PUSHJ P,RHSET
	 JRST RW3
	HRRZ A,RHTPGA		;SET TRACK-SECTOR
	TLO A,%HRADR
	PUSHJ P,RHSET
	 JRST RW3
KL,[	MOVE A,RHTIOW		;SWEEP THE CACHE
	AOS A			;RH ADDRESS OF BUFFER, LH - # WDS
	LSH A,-9.
	TRZ A,777000
	TLO A,777000		;A NOW HAS AOBJN PTR TO PAGES
RWSWP3:	TRNE TT,10		;SWEEP ONE PAGE
	 SWPIO (A)		;IF READING, INVALIDATE
	TRNN TT,10
	 SWPUO (A)		;IF WRITING, UNLOAD
	CONSZ APR,200000	;WAIT UNTIL SWEEPER WAKES
	 JRST .-1
	AOBJN A,RWSWP3
	SWPUO 0			;STORE CHANNEL PROGRAM IN CORE
	CONSZ APR,200000
	 JRST .-1
];KL
;DROPS THROUGH
;DROPS IN
RWGO:	MOVE A,TT		;ISSUE I/O COMMAND
	PUSHJ P,RHSET
	 JRST RW3
	CONSO DSK,%HIDONE	;WAIT FOR COMPLETION
	 JRST .-1
	MOVSI A,%HRSTS		;CHECK DISK STATUS, ERRORS DON'T ALWAYS SHOW UP IN CONI
	PUSHJ P,RHGET
	 JRST RW3
	TRNN A,%HSERR
	 CONSZ DSK,%HIERR
	  CAIA
	   JRST POPJ1		;NO ERROR, SKIP RETURN FROM RW2
;FOLLOWING TWO LINES CAUSE ECC NOT TO WORK
;	CONSO DSK,%HIEXC
;	 POPJ P,		;NOT DRIVE EXCEPTION, PROBABLY CORRIGIBLE BY RETRY
	TRNN A,%HSERR		;ANYTHING IN ERR REGS?
	 JRST RW3		;FOO, WHAT IS GOING ON??
	MOVSI A,%HRER2		;MAKE SURE NO UNSAFES
	PUSHJ P,RHGET
	 JRST RW3
	JUMPN A,RW3
	MOVSI A,%HRER3
	PUSHJ P,RHGET
	 JRST RW3
	JUMPN A,RW3
	MOVSI A,%HRER1		;GET ERROR1 REG
	PUSHJ P,RHGET
	 JRST RW3
	TRNE A,077067		;GROSS ERROR?
	 JRST RW3		;YES, ABORT
	TRZE A,100000		;SEE IF CORRECTABLE DATA ERROR
	 JUMPE A,RWECC		;YES, GO FIX IT
	POPJ P,			;ERROR, BUT RETRY MAY WIN
	  
RW6:	MOVE A,[%HRDCL,,%HMCLR]	;ERROR IN DRIVE, TRY CLEARING
	PUSHJ P,RHSET
	 JRST RW3
	MOVSI A,%HRSTS
	PUSHJ P,RHGET
	 JRST RW3
	TRNN A,%HSERR
	 JRST RW2A		;WON
				;LOST, FALL INTO RW3

RW3:	POP P,(P)		;UNCORRECTABLE ERROR, RW FAILS
	JRST RWL0

;ERROR CORRECTION CODE -- TAKEN FROM MAINDEC-10-DDRPF
; THAT CODE HAD NO HOPE WHATSOEVER OF WORKING.  RETAKEN FROM ITS.
; THAT CODE DIDN'T WORK EITHER.  TAKEN FROM NEWER ITS.

RWECC:	TRNN TT,10		;SKIP IF READ
	 POPJ P,		;RETRY IF WRITE
	INSIRP PUSH P,[B W U J K H]
		DW1==W		;FIRST WORD IN ERROR
		DW2==U		;SECOND WORD IN ERROR
		EP1==J		;FIRST WORD OF ERROR PATTERN
		EP2==K		;SECOND WORD OF ERROR PATTERN
		ADR==H		;ADDRESS OF LOSING WORDS
		;B		;SO CAN DIVIDE A
	SKIPN A,SLVICWA+1	;GET ADDRESS OF LAST WORD TRANSFERRED
	 JRST 4,.-1		;CHANNEL SHOULD HAVE STORED CONTROL WORD
	SOS ADR,A		;LAST WORD TRANSFERRED (SUPPOSEDLY)
	ANDI ADR,-200		;IN ANY CASE, THIS MAKES ADR -> START OF SECTOR
	HRRZ A,RHTIOW		;ADR-1 OF START OF TRANSFER
	SUBM ADR,A
	SOS B,A			;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED
	MOVEM B,RHSUCC		;SAVE
	HLRO K,RHTIOW
	MOVNS K
	CAIL B,0		;CHECK FOR CHANNEL LYING
	 CAILE B,-200(K)
	  JRST RWECC3		;FRAUD, TRANSFERRED NEGATIVE OR TOO MANY WORDS
	MOVSI A,%HRPOS		;GET ERROR POSITION
	PUSHJ P,RHGET
	 JRST RWECC3
	SOJL A,RWECC3		;WHICH IS OFF BY 1.  IF ZERO, LOSE.
	IDIVI A,36.		;CONVERT TO WORD AND BIT
	ADD ADR,A
	MOVS DW1,(ADR)		;FETCH THE TWO LOSING WORDS
	MOVS DW2,1(ADR)
	MOVSI A,%HRPAT		;GET ERROR PATTERN
	PUSHJ P,RHGET
	 JRST RWECC3
	MOVE EP1,A
	SETZ EP2,
	ROTC EP1,(B)		;ALIGN IT
	XOR DW1,EP1		;FIX THE ERRONEOUS BITS
	XOR DW2,EP2
RWECCB:		;SET BREAK HERE IF DON'T TRUST...
	MOVSM DW1,(ADR)		;PUT CORRECTED DATA BACK
	MOVSM DW2,1(ADR)
	INSIRP POP P,[H K J U W]

	AOS CERRS		;COUNT NUMBER OF TIMES ECC DONE
	MOVEI A,%HMCLR		;CLEAR THE ECC-ERROR CONDITION
	PUSHJ P,RHSET
	 JFCL
	MOVEI A,200		;ALLOW FOR THE SECTOR WE CORRECTED
	ADDB A,RHSUCC		;GET BACK NUMBER OF WORDS TRANSFERRED
	IDIVI A,200		;NUMBER OF SECTORS TRANSFERRED INCLUDING CORRECTED ONE
	LDB B,[$HASEC RHTPGA]	;UPDATE DISK ADDRESS
	ADD A,B
	IDIVI A,NSECS
	DPB B,[$HASEC RHTPGA]
	LDB B,[$HATRK RHTPGA]
	ADD A,B
	DPB A,[$HATRK RHTPGA]	;NO NEED TO IDIVI A,NHEDS SINCE ALL XFERS WITHIN CYLINDER
	MOVE A,RHSUCC		;NOW ADVANCE CCW
	HRL A,A
	ADDB A,RHTIOW
	POP P,B
	TLNE A,-1
	 JRST RW2OVR		;NOT EXHAUSTED, CONTINUE DISK XFER
	JRST POPJ1		;ECC IN LAST SECTOR OF XFER, XFER COMPLETED SUCCESSFULLY

RWECC3:	INSIRP POP P,[H K J U W B]
	JRST RW3

;ROUTINES TO ACCESS RH10 CONTROLLER AND DRIVE REGISTERS
;CALL WITH
;	I  UNIT NUMBER
;	A  REGISTER NUMBER IN LH
; NON-SKIP RETURN IF RAE ERROR
; SKIP RETURN IF WIN
;CLOBBERS ONLY A

;SET REGISTER.  TAKES DATA TO GO IN REGISTER IN RH OF A
;CLOBBERS A (PROBABLY)

RHSET:	TLOA A,%HRLOD		;TELL HARDWARE IS SET INSTEAD OF GET
				;AND FALL INTO RHGET

;GET REGISTER.  RETURNS 16 BITS RIGHT-JUSTIFIED IN A

RHGET:	 TLZ A,%HRLOD
	TLO A,(I)		;INSERT PHYS DRV NO
	DATAO DSK,A		;TELL RH10 TO FETCH REGISTER
	MOVEM A,RHLAST'		;SAVE FOR REBUGGING
	MOVEI A,4		;ENSURE 3 USEC DELAY BEFORE DATAI
	SOJG A,.		;TO ALLOW MASSBUS TRANSACTION TO COMPLETE
	DATAI DSK,A		;GET REG CONTENTS AND FLAGS
	TLNE A,%HDERR		;ERROR?
	 JRST RHRAE		;YES, GO REPORT
	ANDI A,177777		;MASK TO 16 BITS
	AOS (P)			;AND TAKE SUCCESS RETURN
	POPJ P,

RHRAE:	MOVSI A,%HRRAE+%HRLOD(I)
	DATAO DSK,A		;CLEAR RAE REGISTER IN CONTROLLER
	POPJ P,			;AND TAKE NON-SKIP RETURN

;DISK ROUTINE VARIABLES

RHCMD:	0	;%HMRED OR %HMWRT
RHIOW:	0	;IOWD -NWDS,,ADR-1 FOR TRANSFER
RHTIOW:	0	;TEMPORARY IOWD FOR CONTINUING FROM ECC
RHPGA:	0	;DISK ADDRESS CYL,,HED_8+SEC
RHTPGA:	0	;TEMPORARY DISK ADDRESS FOR CONTINUING FROM ECC
RHSUCC:	0	;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED BEFORE ECC
];RH

IFN T300P,[	;T-300 I/O - FALL IN FROM WRITE

;ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
; TT %HMWRT OR %HMRED
;ONLY T AND TT CLOBBERED
;ON RETURN T MINUS IF ERROR

T3IO:	INSIRP PUSH P,[A B C D]
	SETOM T3IOP'
	CAIE TT,%HMRED		;GET READ OR WRITE COMMAND
	 SKIPA D,[%DMWRT]
	  MOVEI D,%DMRED
T3IO1:	HRRZ A,J		;GUBBISH IN LH
	IDIVI A,NBLKC1		;A CYLINDER, B BLOCK WITHIN CYLINDER
	MOVEM A,DSCCYL
	IMULI B,SECBL1		;B SECTOR WITHIN CYLINDER
	IDIVI B,NSECS1		;B HEAD, C SECTOR
	MOVEM B,DSCHED
	MOVEM C,DSCSEC
	MOVE B,-3(P)		;ORIGINAL ADDRESS
	HRLI B,730000		;12-BIT BYTES, START WITH FIRST BYTE IN WORD
	MOVE C,[-4,,DSCPNT]	;SET UP BYTE POINTERS
	MOVEM B,(C)
	ADDI B,400
	AOBJN C,.-2
KL,[	SWPUA			;DUMP EVERYTHING OUT OF CACHE
	CONSZ APR,200000
	 JRST .-1
];KL
	PUSHJ P,T3CMD		;PERFORM THE OPERATION
	JUMPE T,T3IO2		;RETURN IF SUCCESS
	MOVE A,T		;SEE IF ERROR MAY BE RECOVERABLE
	TRZ A,%DSECH+%DSIDE+%DSHCE
	JUMPN A,T3IO3		;IF IRRECOVERABLE
	TRNE D,%DMRED		;OR IF NOT A READ COMMAND
	 CAIN D,%DMRED+10	;OR IF TRIED ALL RECOVERY FEATURES
T3IO3:	  TLOA T,(SETZ)		;ENSURE T NEGATIVE TO INDICATE ERROR
	   AOJA D,T3IO1		;OTHERWISE RETRY USING NEXT ERROR RECOVERY FEATURE
T3IO2:	INSIRP POP P,[D C B A]
	POPJ P,
];T300P

SUBTTL MISCELLANEOUS VARIABLES

KL,SALVPF: JRST 4,.		;COME HERE IF PAGE FAIL IN SALVAGER

CONSTANTS
VARIABLES

POPTJ:	POP P,T
CPOPJ:	POPJ P,

THBLK:	-LTHBLK,,0
THTPN:	0	;TAPE #,,REEL # IN THIS DUMP
THDATE:	0	;TAPE CREATION DATE
THTYPE:	0	;0=>RANDOM  >0 => FULL   <0 => INCR
LTHBLK==.-THBLK

MHBLK:	-LMHBLK,,0	;FILE HEADER BLOCK
MHSNM:	0	;SYS NAME
MHFN1:	0	;FN1
MHFN2:	0	;FN2
MHPKN:	0	;PACK #
MHDATE:	0	;CREATION DATE
LMHBLK==.-MHBLK
LNKFLG:	0	;NONZERO => RELOADING LINK
LNKNM1:	0	;LINK FN1
LNKNM2:	0	;LINK FN2
LNKSNM:	0	;LINK SNAME
MAGHD:	0
EOTFLG:	0
EOFCNT:	0
EOUF:	0
SHORTL:	0
MTRYS:	0
MAGBFP:	0
EOFLG:	0

FROM:	0
TOU:	0

SBTAB:	-1	;FOR PATCHING
	-1
	-1
	-1
MFDBK:	MFDBLK	;SPECIAL RESERVED BLKS
	;TUT USED TO BE HERE, BUT NO LONGER
LSBTAB==.-SBTAB

;THIS IS AN ARRAY INDEXED BY UNIT GIVING THE NUMBER
;OF BLOCKS IN THE TUT ON THAT UNIT.
;THESE BLOCKS ARE ALWAYS RIGHT BEFORE THE MFD.
NTBL:
IFE T300P, REPEAT NUNITS, NTUTBL
IFN T300P,[
	REPEAT T300P, NTUTBL
	REPEAT NUNITS-T300P, NTUTB1
];T300P

RXWDS:	BLOCK 4	;THE EXTRA WORDS

	0	;FOR BLT
WXWDS:	BLOCK 4

NOLPT:	0	;-1 FOR NO LPT
LPBUST:	-1	;-1 LPT IS BUSTED DON'T KEEP ASKING
PUNCH:	0	;SET TO -1 WITH DDT IF COPY TTY OUTPUT TO PUNCH
HCRASH:	0	;SET TO -1 WITH DDT IF EMERGENCY DUP AFTER HEAD CRASH
		;SACRAFICE EVERYTHING FOR SPEED SINCE PACK IS BEING SCRAPED BY HEADS
NUDS:	NTS,[NUDSL]+0 ;NUMBER OF USER DIRECTORY BLOCKS
ADRSET:	0	;ADDRESS SET
FMBLK:	0	;FROM BLOCK
TOBLK:	0	;TO BLOCK
LFRMSW:	0
SEEKC:	0
SHARED:	0	;NUMBER OF SHARED BLOCKS
GOGOX:	0	;-1 FOR AUTOMATIC MODE
NOQUES:	0	;-1 TO ASK NO QUESTIONS (ONLY EFFECTIVE IN GOGOX MODE)
MDSK:	0	;DISK TO GET MFD FROM
UDSK:	0	;DSK TO GET UFD'S FROM
CKFLSW:	0	;CHECK FILES FOR CLOBBERED BLOCKS
MFDWRT:	0	;MFD CHANGED
TUTDFR:	0	;FLAG TO SHOW TUT CHANGED
TTDFPS:	0	;COUNT FROBS PER LINE WHEN PRINTING TUT
LFILES:	0	;NUMBER OF FILES IN DIRECTORY
USRNAM:	0	;M.F.D. USR NAME
UFDLOS:	0	;SOME GARBAGE IN UFD
UFDSEE:	0	; -1 IF A STRANGE UFD, PRINT WHOLE THING
FILEPK:	0	; PACK FILE IS ON
LAST:	0	; LAST FILE IN UFD
DBLK:	0	;STORAGE FOR DIRECTORY NUMBER
FILEER:	0	;ERROR IN FILE
BADFIL:	0	; BLOCKS IN FILE WITH RETRIEVAL ERRORS
XWDSEE:	0	; -1 IF HAVENT TYPED EXTRA WORDS YET
LASTQ:	0	;STORAGE FOR Q
NOTUT:	0	;TUT NOT ACTIVE FOR THIS FILE
LSTBLK:	0	;LAST BLOCK STORAGE
BLK:	0	; LAST BLOCK READ OR WRITTEN FROM
CKFIX:	0	; -1 IF AUTO FIX RETRIEVAL POINTERS
UNIT:	0	; UNIT   "
FUNIT:	0	; UNIT FILE IS ON, -1 IF PACK NOT MOUNTED
FERRS:	0	;TRANSFER ERRORS
CERRS:	0	;ERRORS CORRECTED BY ECC LOGIC
DUPRER:	0	;DUP READ ERROR COUNT
DUPWER:	0	;DUP WRITE ERROR COUNT
UFDTA:	0
GARBF:	0	;GARBAGE IN FREE AREA
EXGARB:	0	;EXTRA GARBAGE IN UFD
MARKF:	0	;MARKING PACK

PDL:	BLOCK 200
QBTBLI:	440600,,
QBTBL:	360600,,
	300600,,
	220600,,
	140600,,
	60600,,
	600,,

QTRAN:
DC,[	0		;RH IS PHYSICAL DRIVE
	1		;4.9 BIT MEANS SECOND HALF
	2		;(NO LONGER DOES ANYTHING, NOW THAT MEMOWRECKS HAVE BEEN
	3		; FLUSHED, BUT KEEP AROUND IN CASE EVER NEEDED AGAIN.)
	4
	5
	6
	7
];DC
.ELSE REPEAT NDRIVE, .RPCNT	;OTHERWISE NOTHING SPECIAL

IFN .-QTRAN-NUNITS,.ERR BARF AT QTRAN!!

QTTBLI:	REPEAT 36./TUTBYT+1,	440000+TUTBYT_6-TUTBYT_12.*.RPCNT,,
QTTBL=QTTBLI+1

TS, NQS:	0	;SYSTEMS NUMBER OF DRIVES
TS, SQACT:	0	;LOCATION OF QACT IN SYSTEM
TS, SALVRT:	0	;DUMMY

	NBLKS-1		;SNBLKS-1
SNBLKS:	NBLKS		;SYSTEM NBLKS (INIT'ED IN TS)
DRIVE:	REPEAT NDRIVE,-1	;-1 IF DRIVE ON LINE
QACT:	REPEAT NUNITS,-1	;-1 IF UNIT ACTIVE
QPKN:	REPEAT NUNITS,-1	;PACK NUMBER ACCORDING TO TUT
PKNUM:	BLOCK NUNITS		;PACK NUMBER ACCORDING TO HARDWARE

RPKID:	0

IRP A,,[OTUT,NTUT]
Q!A!O:	REPEAT NUNITS,CONC A,\.RPCNT,
TERMIN

PAT:
PATCH:	BLOCK 100

LOC <.+1777>&776000
CYLBUF:
OUSRD:	BLOCK 2000
NUSRD:	BLOCK 2000
FDBUF:	BLOCK 2000
MFD:	BLOCK 2000
MAGBUF:	BLOCK 2000
IRPS A,,OTUT NTUT
REPEAT NUNITS,CONC A,\.RPCNT,:	BLOCK 2000*MXTUTB
TERMIN
D0==OTUT0
D1==OTUT1
TUT=NTUT0
RH, CYLSIZ==200*NHEDS*NSECS
RP, CYLSIZ==NBLKSC*2000
DC, CYLSIZ==NBLKSC*2004
NTS, IFL .-CYLBUF-CYLSIZ,LOC CYLBUF+CYLSIZ
THEEND:
CONSTANTS
VARIABLES
IFN .-THEEND, .ERR CRUFT AFTER THEEND

INFORM HIGHEST USED = ,\THEEND

IFG THEEND-400000, .ERR TOO MOBY (MUST FIT IN 128K TO AVOID HOLE IF SOME MEM DOWN)
;This error check doesn't really matter for MC much, since memory has
;to be switched out in 128K increments, which means that the system
;can't work with any holes in the low 256K.

IF2, NTS, KL, PAG=<BLKO PAG,>-<BLKO>

TS, END DDT		;ALWAYS STARTED BY <COMMAND>G
NTS,END <MEMSIZ-4000>	;DON'T CLOBBER I.T.S. START ADDR WHEN LOADED TOGETHER
